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Preface 


The  purpose  of  IDA  Document  D-575,  An  Add  SQL  UNITREP  Demonstration ,  is  to  demon¬ 
strate  how  the  Ada/SQL  Ada-DBMS  interface  can  be  used  to  implement  a  portion  of  the  UNI¬ 
TREP  message  processing  application. 


The  importance  of  this  document  is  based  on  partial  fulfillment  of  Task  Order  T-W5-206, 
WIS  Application  Software  Study,  which  is  to  demonstrate  the  general  mechanics  of  developing 
Ada/SQL  applications.  As  a  Document,  D-575  is  directed  toward  users  who  are  concerned  with 
how  an  Ada/SQL  system  is  implemented  and  operates. 
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1.  Purpose 

This  latest  demonstration  of  Ada/SQL  technology  was  designed  to  take  advantage  of  the  fol¬ 
lowing  new  features: 

•  Strongest  typing  of  effective  functions,  as  described  in  the  latest  Ada/SQL  specification 
[M362],  but  not  implemented  in  earlier  releases.  Additional  typing  includes: 

—  Strong  typing  of  Ada/SQL  syntactic  classes, 

—  Strong  typing  by  table  for  update, 

—  All  other  strong  typing  was,  of  course,  retained. 

•  Support  for  null  values,  not  previously  implemented 

•  Implementation  on  an  IBM1  PC  workstation,  not  requiring  special  hardware  (the  Meridian 
AdaVantage  compiler  was  used,  and  the  demonstration  can  be  compiled  and  run  on  a  PC 
with  640K  of  RAM) 

Additional  references  to  published  reports  on  Ada/SQL  can  be  found  in  [M362,  M459, 
M460], 

2.  Experience 

It  was  originally  desired  to  to  implement  the  entire  UNTTREP  application  on  the  IBM  PC. 
However,  it  quickly  became  apparent  that  limitations  of  the  Meridian  compiler  prevented  rapid 
implementation.  Although  the  complete  implementation  would  probably  ultimately  be  feasible, 
the  effort  required  would  not  be  practical  merely  for  a  demonstration  of  this  nature. 

The  particular  limitations  of  the  Meridian  compiler  that  caused  problems  are: 

•  Nested  generics  (and  even  some  aspects  of  non-nested  generics)  either  do  not  compile  at  all 
or  produce  erroneous  code.  The  existing  Ada/SQL  runtime  system  relies  heavily  on  nested 
generics  for  generating  its  required  subprograms.  Consequently,  existing  code  could  not  be 
directly  used  for  the  demonstration. 

•  Neither  internal  compiler  tables  nor  the  generated  code  are  compact.  Consequently,  compi¬ 
lation  and  linking  memory  become  a  problem  for  large  programs. 

The  problem  with  generics  was  circumvented  by  recoding  key  Ada/SQL  runtime  routines  to 
not  be  generic.  Although  this  simplifies  the  underlying,  application-independent  routines,  it 
complicates  the  code  that  must  be  generated  for  application-specific  references  to  Ada/SQL 
entities  (e.g.,  statements,  table/column  names,  etc.)  Furthermore,  the  existing  Ada/SQL  appli¬ 
cation  scanner  generates  code  for  the  highly  generic  underlying  implementation.  Therefore,  the 
application  scanner  could  not  be  used  to  generate  the  code  required  for  the  demonstration,  and 
that  code  had  to  be  hand-generated. 


1.  IBM  is  a  registered  trademark  of  International  Business  Machines  Corp. 
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The  memory  space  problem  was  circumvented  by  only  implementing  processing  for  one  of  the 
UN1TREP  card  types,  and  by  omitting  all  the  ancillary  message  processing  (not  germane  to  data¬ 
base  interface).  Implementing  the  other  card  types  would  have  required  a  level  of  effort  beyond 
that  which  is  reasonable  for  a  simple  demonstration  anyway,  due  to  the  requirement  to  hand- 
generate  all  application-specific  Ada/SQL  code.  Nevertheless,  important  lessons  about  database 
interface,  program  structure,  and  software  engineering  can  be  learned  from  the  card  type  coded. 


3.  Database  Interface,  Program  Structure,  and  Software  Engineering 

The  original  SORTS  (renamed  UNITREP)  code  relevant  to  this  demonstration  is  extracted  in 
CARDA.OLD.  There  are  many  auxiliary  packages  and  subprograms  used  by  the  code  shown 
but  not  included,  since  their  functions  can  be  deduced  from  the  names  by  which  they  are  refer¬ 
enced.  (Program  files  are  included  at  the  end  of  this  document,  identified  by  file  name,  when  the 
document  is  in  printed  form.  When  the  document  is  in  machine-readable  form,  program  files  are 
included  on  the  disk  under  the  names  given.) 

First,  the  fashion  of  the  database  interface  should  be  noted.  (These  comments  are  made  con¬ 
cerning  database  interfaces  in  general,  not  to  be  critical  of  the  SORTS  code.  The  SORTS  imple¬ 
mentation  was  designed  to  demonstrate  features  other  than  the  database  interface,  on  the  IBM 
PC.  The  developers  of  the  code  did  not  have  an  actual  IBM  PC  database  interface  available,  and 
so  their  interface  is  meant  to  be  illustrative  rather  than  operational.) 

In  the  original  code,  database  commands  are  assembled  component  by  component,  with  suc¬ 
cessive  clauses  appended  to  a  string.  This  string  is  then  provided  to  the  database  interface.  Such 
an  interface  is  fine  for  non-transaction-oriented,  low  volume  applications,  but  has  serious  perfor¬ 
mance  ramifications  for  high-volume,  transaction-oriented  systems.  This  is  because  the  database 
management  system  must  parse  the  string  each  time  a  command  is  issued,  and  then  decide  on 
optimal  data  access  strategy.  For  simple  database  operations  such  as  those  used  in  the  demons¬ 
tration,  this  processing  represents  a  very  major  portion  of  the  total  processing  required  to  per¬ 
form  the  command. 

In  our  Ada/SQL  version  of  the  same  code,  contained  in  CARDA.ADB,  we  have  replaced 
the  string  interface  with  database  commands  that  can  be  processed  at  compile  time.  This  enables 
much  time-consuming  database  processing  to  be  performed  before  the  program  actually  runs, 
enabling  implementation  of  high-performance  applications.  (The  implementation  used  for  the 
demonstration  does  not  actually  perform  this  database  processing  at  compile  time,  but  the  same 
application  code  could  be  used  in  a  system  that  would.) 

Of  course,  building  database  commands  in  strings  does  provide  a  degree  of  flexibility  exceed¬ 
ing  that  which  is  available  with  compilable  commands.  In  the  original  SORTS  code,  this  flexibil¬ 
ity  allows  optional  insert  and  update  of  column  values.  But  is  this  flexibility  really  required  to 
perform  the  operations?  No;  we  accomplish  the  same  results  using  null  values.  (At  the  time  the 
original  SORTS  code  was  written,  no  Ada/SQL  implementation  supported  null  values.) 

When  building  a  command  to  insert  data,  the  original  SORTS  code  simply  omits  a  column  for 
which  no  data  is  supplied.  But  the  database  contains  such  a  column,  and  the  column  must  be 
filled  with  something,  so  what  gets  placed  in  such  a  column?  In  ANSI  standard  SQL,  an 
unspecified  column  is  filled  with  a  null  value.  Our  database  commands,  being  fixed  at  compile 
time,  must  provide  for  inserting  data  into  all  columns  of  a  table.  But,  by  using  the 
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INDICATOR_VARIABLE  feature  of  Ada/SQL,  we  achieve  the  same  effect  of  placing  null 
values  into  columns  for  which  no  data  has  been  supplied. 

When  building  a  command  to  update  data,  the  original  SORTS  code  omits  those  columrs  for 
which  the  data  are  to  remain  unchanged.  Again,  since  our  database  commands  are  fixed  at  com¬ 
pile  time,  we  must  provide  for  updating  all  columns  of  a  table.  In  order  to  achieve  the  effect  of 
leaving  some  columns  unchanged,  we  first  retrieve  the  existing  data,  then  set  those  values  back 
into  the  columns  that  should  not  be  changed,  using  new  data  only  for  those  columns  that  should 
be  updated.  Because  of  the  overhead  involved  in  parsing  and  planning  data  access  strategy,  our 
retrieve/update  done  in  a  precompiled  fashion  should  provide  better  performance  than  a  single 
update  done  via  a  string  interface. 

The  Ada/SQL  interface  provides  other  advantages  as  well,  relating  to  program  structure  and 
software  engineering.  Much  of  the  logic  in  the  original  SORTS  code  is  devoted  to  building  data¬ 
base  command  strings.  The  relationships  between  input  format  and  database  structure  are  some¬ 
what  obscured  by  all  the  command  string  logic.  In  the  Ada/SQL  version,  each  database  com¬ 
mand  is  a  single  Ada  statement.  That,  coupled  with  the  structure  we  have  built  for  converting 
from  input  format  to  program  variables,  makes  the  relationship  between  input  and  database 
immediately  apparent.  This  clarity  of  program  operation  has  obvious  value  for  reliability  and 
maintainability. 

In  addition  to  the  visual  formatting  advantage,  the  Ada/SQL  approach  provides  strong  type 
checking.  In  our  demonstration,  input  data  are  converted  from  “card  images”.  The  converted 
data  are  placed  in  program  variables  which  are  appropriately  typed.  All  database  operations  on 
those  program  variables  then  provide  strong  type  checking.  For  example,  a  value  of  one  type 
cannot  be  used  to  update  a  column  of  another.  Contrariwise,  there  is  no  strong  type  control  with 
a  string  interface.  Once  a  value  is  placed  in  a  command  string,  all  type  information  is  lost,  and 
the  database  interface  has  no  way  of  verifying  correct  typing. 


4.  References 


[M362]  Ada/SQL  Binding  Specifications,  F.  Friedman  and  B.  Brykczynski.  IDA  Memoran¬ 
dum  Report  M-362.  June  1988.  VA:  Institute  for  Defense  Analyses. 

[M459]  An  Oracle  -  Ada/SQL  Implementation,  F.  Friedman,  B.  Brykczynski  and  K.  Hilliard. 
IDA  Memorandum  Report  M-459,  April,  1988.  VA:  Institute  for  Defense  Analyses. 

[M460]  An  Ada/SQL  Application  Scanner,  F.  Friedman,  K.  Heatwole,  K.  Hilliard  and  B. 

Brykczynski.  IDA  Memorandum  Report  M-460,  March  1988.  VA:  Institute  for 
Defense  Analyses. 


5.  Source  Files 

The  source  files  for  the  demonstration,  listed  in  an  order  suitable  for  compilation,  are: 
DATABASE.ADA  -  type  definitions  used  by  the  Ada/SQL  system  (as  defined  in  the  Ada/SQL 
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specification,  declares  types  indicating  the  maximum  range  of  values  supported  by  the  database). 
TXTPRT.ADA  -  utility  routines  for  printing  and  formatting  text. 

FUNCTION.ADS  and  FUNCTION.ADB  -  the  underlying  application-independent  Ada/SQL 
runtime  implementation  environment,  adapted  specifically  for  this  demonstration  by  recoding 
without  generics.  Ada/SQL  features  unused  by  the  demonstration  are  not  included  in  these  files, 
to  save  the  unnecessary  work  of  recoding  unused  items  to  also  omit  generics.  Emulation  of  the 
specific  database  commands  used  in  the  demonstration  is  provided  -  values  inserted  and 
updated  are  retained  and  may  be  retrieved  or  deleted.  This  emulation  applies  only  to  the  exact 
commands  used  in  the  demonstration,  however,  and  will  not  work  on  other  database  commands. 
When  commands  are  performed,  their  operation  is  also  printed,  so  that  the  results  of  the 
demonstration  can  be  seen. 

DBTYPES.ADS  -  type  definitions  for  UNITREP  data  used  in  the  demonstration. 

GENPACK.ADA  -  the  “generated  package”  for  CARDA.ADB  (see  below),  defining  the 
application-dependent  Ada/SQL  environment.  In  the  existing  Ada/SQL  implementations,  this 
is  generated  by  the  application  scanner.  For  this  demonstration,  however,  it  was  hand-generated, 
as  already  noted,  to  circumvent  problems  with  the  Meridian  compiler. 

DBVARS.ADA  -  the  “generated  package”  for  DBVARS.ADB  (see  below). 

DBVARS.ADS  -  definitions  of  variables  used  for  database  communication  in  the  demonstration 
(variables  correspond  to  fields  in  the  UNITREP  input). 

DBCGEN.ADA  -  generic  routines  to  convert  data  from  the  UNITREP  “card  images”  to  vari¬ 
ables  of  the  appropriate  type.  Conversions  are  provided  for  discrete  (integer  and  enumeration), 
string,  and  flag  (blank  or  X  on  UNITREP  “card  image”,  converted  to  BOOLEAN  for  use  by 
Ada  program)  data  types.  Two  kinds  of  conversions  are  provided,  according  to  the  following 
rules:  For  inserting  discrete  and  string  data,  a  blank  field  causes  i  mill  value  to  be  used  in  the 
database,  otherwise  the  given  data  is  used.  For  inserting  flag  data,  a  blank  is  FALSE  and  an  X  is 
TRUE.  For  updating  discrete  and  string  data,  a  pound  sign  (#)  causes  an  update  to  a  null  value, 
a  blank  field  causes  the  original  data  to  not  be  updated,  and  anything  else  causes  an  update  to  the 
given  value.  For  updating  flag  data,  a  pound  sign  causes  an  update  to  FALSE,  a  blank  causes  the 
original  data  to  not  be  updated,  and  an  X  causes  an  update  to  TRUE. 

DBCNVRT.ADS  -  instantiations  of  the  conversion  routines  in  DBCGEN.ADA  for  the  types 
used  in  the  UNITREP  demonstration. 

CARDA.ADS  and  CARDA.ADB  -  code  to  process  a  single  UNITREP  card  type,  based  on  the 
original  SORTS  code,  but  totally  rewritten  to  use  Ada/SQL. 

MAIN. ADA  -  driver  for  the  demonstration;  contains  several  UNITREP  “card  images”  which  are 
echoed  and  fed  to  the  processing  routine  in  sequence. 


6.  Demonstration  Output 

MAIN.EXE  contains  the  demonstration  program,  which  can  be  run  on  virtually  any  IBM  PC 
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or  compatible.  The  output  produced  by  this  program  is  in  DEMO. OUT.  (The  demonstration 
normally  produces  output  on  the  screen,  but  the  output  can  be  redirected  to  a  file.)  The  output 
shows  the  database  operations  performed,  in  ANSI  SQL,  and  the  results  retrieved  by  SELECs. 
Enumeration  values  show  up  as  integers  in  the  output,  according  to  their  ’POS.  This  is  because 
Ada/SQL  is  designed  to  interface  to  existing  database  management  systems  which  do  not,  in 
general,  support  enumeration  types.  Hence,  enumeration  values  are  converted  to  integers  for 
interchange  with  the  database  management  system.  This  conversion  is  performed  by  the  inter¬ 
face;  the  application  program  treats  enumeration  values  as  it  should  (as  enumeration  values!). 


5 

UNCLASSIFIED 


UNCLASSIFIED 


7.  Source  Listings 


7.1  DATABASE.  ADA 


—  File:  database. ads 

—  DATABASE 
--  12/18/88 


DISCLAIMER  OF  WARRANTY  AND 


LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J .  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  SYSTEM; 
package  DATABASE  is 

type  INT  is  range  SYSTEM. MIN_INT  . .  SYSTEM. MAX_INT; 

type  DOUBLE_PRECISION  is  new  STANDARD . FLOAT ; 
type  CHAR  is  new  STANDARD . STRING; 

type  USER_AUTHORIZATION_IDENTIFIER  is  new  STANDARD . STRING; 
type  COLUMN_NUMBER  is  new  STANDARD . INTEGER; 
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end  DATABASE; 
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7.2  TXTPRT.ADA 


—  File :  txtprt . ada 

—  TEXT_PRINT  -  specially  tailored  for  UNITREF  demo  -  not  for  other  use 
--  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
13C1  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J .  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  DATABASE,  TEXT_IO; 

use  TEXT_IO; 
package  TEXT_PRINT  is 

type  LINE_TYPE  is  limited  private; 

type  BREAKJTYPE  is  (BREAK,  NO_BREAK ) ; 

type  PHANTOM_TYPE  is  private; 
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procedure  CREATE_LINE ( LINE  :  in  out  LINEJTYPE;  LENGTH  :  in  POSITIVE); 
procedure  SET_LINE (LINE  :  in  LINEJTYPE) ; 
function  CURRENT_LINE  return  LINEJTYPE; 

procedure  SET_INDENT ( LINE  :  in  LINEJTYPE;  INDENT  :  in  NATURAL); 

procedure  SET_INDENT ( INDENT  ;  in  NATURAL); 

procedure  SET_CONT INUAT I ON_INDENT ( LINE  :  in  LINEJTYPE; 

INDENT  :  in  INTEGER); 
procedure  SET_CONTINUATION_INDENT( INDENT  :  in  INTEGER); 

function  MAKE_PHANTOM( S  :  STRING)  return  PHANTOM_TYPE ; 

procedure  SET_PHANTOMS ( LINE  :  in  LINEJTYPE; 

START_PHANTOM, 

END_PHANTOM  :  in  PHANTOM_TYPE ) ; 

procedure  SET_PHANTOMS(START_PHANTOM,  END_P HANT OM  :  in  PHANTOM_TYPE ) ; 

procedure  PRINT (FILE  :  in  FILEJTYPE; 

LINE  :  in  LINEJTYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK  JTYPE  :=  BREAK); 

procedure  PRINT (FILE  :  in  FILEJTYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  :  =»  BREAK); 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAKJTYPE  : =  BREAK); 

procedure  PRINT ( ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  : =  BREAK ) ; 

procedure  PRINT_LINE( FILE  :  in  FILE_TYPE;  LINE  :  in  LINE_TYPE) ; 
procedure  PRINT_LINE (FI LE  :  in  FILE_TYPE) ; 
procedure  PRINT_LINE ( LINE  :  in  LINE_TYPE) ; 
procedure  PRINT_LINE; 

procedure  BLANK_LINE( FILE  :  in  FILE_TYPE;  LINE  :  in  LINEJTYPE) ; 
procedure  BLANK_LINE( FILE  :  in  FILE_TYPE) ; 
procedure  BLANK_LINE ( LINE  :  in  LINE_TYPE); 
procedure  BLANK_LINE; 

-generic  *****  hard-wire  for  Meridian  Ada 
type  NUM  is  range  <>; 
subtype  NUMI  is  DATABASE . INT; 
package  INTEGER_PRINT  is 

procedure  PRINT ( FILE  :  in  FILE_TYPE; 

LINE  :  in  LINE_TYPE; 
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ITEM  :  in  NUMI; 

BRK  :  in  BREAK_TYPE  BREAK); 

procedure  PRINT (FILE  s  in  FILE_TYPE; 

ITEM  :  in  NUMI; 

BRK  :  in  BREAK_TYPE  BREAK); 

procedure  PRINT (LINE  :  in  LINEJIYPE; 

ITEM  :  in  NUMI; 

BRK  :  in  BREAKJTYPE  : -  BREAK ) ; 
procedure  PRINT (ITEM  :  in  NUMI; 

BRK  :  in  BREAK_TYPE  :=  BREAK); 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUMI) 
end  INTEGER_PRINT ; 

— generic  *****  hard-wire  for  Meridian  Ada 
type  NUM  is  digits  <>; 
subtype  NUMF  is  DATABASE. DOUBLEJPRECISION; 
package  FLOATJPRINT  is 

procedure  PRINT (FILE  :  in  FILEJTYPE; 

LINE  :  in  LINEJTYPE; 

ITEM  :  in  NUMF; 

BRK  :  in  BREAKJTYPE  :=  BREAK); 

procedure  PRINT (FILE  :  in  FILEJTYPE; 

ITEM  :  in  NUMF; 

BRK  :  in  BREAKJTYPE  :=  BREAK); 

procedure  PRINT (LINE  :  in  LINEJTYPE; 

ITEM  :  in  NUMF; 

BRK  :  in  BREAKJTYPE  :=  BREAK); 

procedure  PRINT (ITEM  :  in  NUMF; 

BRK  :  in  BREAK_TYPE  :=  BREAK); 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUMF) 
end  FLOAT_PRINT; 

NULL_PHANTOM  :  constant  PHANTOMJTYPE ; 

LAYOUT_ERROR  :  exception  renames  TEXT_IO . LAYOUT_ERROR; 
private 

type  PHANTOMJTYPE  is  access  STRING; 


type  LINE_REC ( LENGTH  : 
record 

INTEGER)  is 

USED_YET 

:  BOOLEAN 

=  FALSE; 

INDENT 

:  INTEGER 

=  0; 

CONTINUATION_INDENT 

:  INTEGER 

=  2; 

BREAK 

:  INTEGER 

=  1; 
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INDEX  :  INTEGER  : -  1; 

DATA  :  STRING (1. .LENGTH) ; 

STARTJPHANTOM, 

END_PHANTOM  :  PHANTOM  JTYPE  :*  NULL_PHANTOM; 

end  record; 

type  LINEJTYPE  is  access  LINE_REC; 

NULL_PHANTOM  :  constant  PHANT OM_T YP E  :=  new  STRING' 
end  TEXT_PRINT; 
package  body  TEXT_PRINT  is 
DEFAULT_LINE  :  LINEJTYPE; 

procedure  CREATE_LINE ( LINE  :  in  out  LINEJTYPE;  LENGTH  :  in  POSITIVE)  is 
begin 

LINE  :=  new  LINE_REC ( LENGTH ) ; 
end  CREATE_LINE; 

procedure  SET_LINE ( LINE  :  in  LINEJTYPE)  is 
begin 

DEFAULT_LINE  :=  LINE; 
end  SET_LINE; 

function  CURRENT_LINE  return  LINEJTYPE  is 
begin 

return  DEFAULT_LINE ; 
end  CURRENT_LINE; 

procedure  SET_INDENT ( LINE  :  in  LINE_TYPE;  INDENT  :  in  NATURAL)  is 

begin 

if  INDENT  >=  LINE. LENGTH  then 
raise  TEXT_IO . LAYOUT_ERROR ; 
end  if; 

if  LINE. INDEX  =  LINE. INDENT  +  1  then 
for  I  in  1 . . INDENT  loop 
LINE . DATA( I )  :=  '  '; 
end  loop; 

LINE . INDEX  : =  INDENT  +  1 ; 
end  if; 

LINE. INDENT  :=  INDENT; 
end  SET_INDENT; 

procedure  SET_INDENT ( INDENT  :  in  NATURAL)  is 
begin 

SET_INDENT ( DEFAULT_LINE , INDENT ) ; 
end  SET_INDENT ; 

procedure  SET_CONTINUATION_INDENT ( LINE  :  in  LINE_TYPE; 
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INDENT  :  in  INTEGER)  is 

begin 

if  LINE. INDENT  +  INDENT  >=  LINE. LENGTH  or  else  LINE. INDENT  +  INDENT  <  0 
then 

raise  TEXT_IO . LAYOUT_ERROR ; 
end  if; 

LINE . CONTINUATION_INDENT  :=  INDENT; 
end  SET_CONTINUATION_INDENT; 

procedure  SET_CONTINUATION_INDENT ( INDENT  :  in  INTEGER)  is 
begin 

SET_CONTINUATION_INDENT ( DEF AULT_L I NE , INDENT ) ; 
end  SET_CONTINUATION_INDENT; 


function  MAKE_PHANTOM{ S  :  STRING)  return  PHANTOM_TYPE  is 
begin 

return  new  STRING ' ( S ) ; 
end  MAKE_PHANTOM; 

procedure  SET_PHANTOMS ( LINE  :  in  LINE_TYPE; 

START_PHANTOM , 

END_PHANTOM  :  in  PHANTOM_TYPE )  is 

begin 

LINE . START_PHANTOM  :=  START_PHANTOM; 

LINE . END_PHANTOM  :=  END_PHANTOM; 
end  SET_PHANTOMS ; 

procedure  SET_PHANTOMS ( START_PHANTOM,  END_PHANTOM  :  in  PHANTOM_TYPE )  is 
begin 

SET_PHANTOMS ( DEFAULT_LINE , START_PHANTOM, END_PHANTOM) ; 
end  SET_PHANTOMS ; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  :  in  LINE_TYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
NEW_BREAK,  NEW_INDEX  :  INTEGER; 
begin 

if  LINE. INDEX  +  ITEM' LENGTH  +  LINE . END_PHANTOM' LENGTH  >  LINE. LENGTH  +  I 
then 

if  LINE. INDENT  +  LINE . CONTINUATION_INDENT  +  LINE . ST ART_PHANTOM' LENGTH  + 
LINE. INDEX  -  LINE. BREAK  +  ITEM' LENGTH  >  LINE. LENGTH  then 
raise  TEXT_IO . LAYOUT_ERROR; 
end  if; 

if  ITEM  =  "  "  and  then  LINE . END_PHANTOM . all  =  ""  then 
return; 
end  if; 

PUT_LINE( FILE, LINE. DATA(1. . LINE . BREAK-1 )  &  LINE . END_PHANTOM . all ) ; 
for  I  in  1 . .LINE. INDENT  +  LINE . CONTINUATION_INDENT  loop 
LINE . DATA( I )  :=  '  '; 

end  loop; 
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NEW_BREAK  : -  LINE. INDENT  +  LINE . CONTINUATION_INDENT  +  1; 
NEW_INDEX  NEW_BREAK  +  LINE. START_PHANTOM' LENGTH  + 

LINE. INDEX  -  LINE. BREAK; 

LINE . DATA ( NEW_B REAK . . NEW_INDEX-1 )  : -  LINE . START_PHANTOM . all  & 
LINE . DATA ( LINE . BREAK . . LINE . INDEX- 1 ) ; 

LINE. BREAK  NEW_BREAK ; 

LINE. INDEX  NEW_INDEX; 
end  if; 

NEW_ INDEX  LINE. INDEX  +  ITEM ' LENGTH ; 

LINE. DATA(LINE. INDEX. .NEW_IND EX- 1)  ITEM; 

LINE. INDEX  :=  NEW_INDEX; 
if  BRK  =  BREAK  then 

LINE. BREAK  :=  NEW_INDEX; 
end  if; 

LINE .  USED_YET  : =  TRUE; 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILEJIYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAKJTYPE  :=  BREAK)  is 

begin 

PRINT ( FILE , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  STRING; 

BRK  s  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  STRING;  BRK  :  in  BREAKJTYPE  :=  BREAK)  is 
begin 

PRINT ( CURRENT_OUTPUT , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINTLINE  ( FILE  :  in  FILE_TYPE;  LINE  :  in  LINE_TYPE)  is 
begin 

if  LINE. INDEX  /=  LINE. INDENT  +  1  then 

PUT_LINE( FILE, LINE. DATA(1. .LINE. INDEX- 1) ) ; 
end  if; 

for  I  in  1 .. LINE . INDENT  loop 
LINE . DATA( I )  : -  '  '; 
end  loop; 

LINE. INDEX  :=  LINE. INDENT  +  1; 

LINE. BREAK  LINE. INDEX; 
end  PRINT_LINE; 

procedure  PRINTLINE  (FILE  :  in  FILE_TYPE)  is 
begin 

PRINTLINE (  FILE,  DEFAULT_LINE)  ; 
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end  PRINT_LINE; 

procedure  PRINTLINE  (LINE  :  in  LINEJIYPE)  is 
begin 

PRINTLINE  (  CURRENT_OUTPUT ,  LINE )  ; 
end  PRINTLINE; 

procedure  PRINT_LINE  is 
begin 

PRINTLINE  (  CURRENT_OUTPUT ,  DEFAULT_LINE )  ; 
end  PRINTLINE; 

procedure  BLANK_LINE ( FILE  :  in  FILE_TYPE;  LINE  :  in  LINE_TYPE)  is 
begin 

if  LINE . USED_YET  then 
NEWSLINE (FILE)  ; 
and  if; 

end  BLANK_LINE; 

procedure  BLANK_LINE ( FILE  :  in  FILEJTYPE)  is 
begin 

BLANK_LINE ( FILE , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

procedure  BLANK_LINE ( LINE  :  in  LINEJTYPE)  is 
begin 

BLANK_LINE ( CURRENT_OUTPUT , LINE ) ; 
end  BLANK_LINE; 

procedure  BLANK_LINE  is 
begin 

BLANK_LINE ( CURRENT_OUTPUT , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

package  body  INTEGER_PRINT  is 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  :  in  LINEJTYPE; 

ITEM  :  in  NUMI; 

BRK  :  in  BREAK JTYPE  :=  BREAK)  is 

S  :  STRING (1. .NUMI 'WIDTH ) ; 

L  :  NATURAL; 
begin 

PRINT (S,L, ITEM) ; 

PRINT (FILE, LINE, S(l. . L) ,BRK) ; 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUMI; 

BRK  :  in  BREAK_TYPE  :=>  BREAK)  is 

begin 
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PRINT { FILE, DEFAULT_LINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUMI ; 

BRK  :  in  BREAK_TYPE  BREAK)  is 

begin 

PRINT (CURRENT_OUTPUT, LINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  NUMI; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUMT)  i 
S  :  constant  STRING  :=  NUMI ' IMAGE ( ITEM) ; 

F  =  NATURAL  :=  S' FIRST;  —  Bug  in  DG  Compiler  —  S' FIRST  /=  1  !  !  ! 

L  :  NATURAL; 
begin 

if  S(F)  =  '  '  then 
F  F  +  1; 
end  if; 

if  TO' LENGTH  <  S' LAST  -  F  +  1  then 
raise  TEXT_IO . LAYOUT_ERROR; 
end  if; 

L  :»  TO' FIRST  +  S'LAST  -  F; 

TO(TO' FIRST. .L)  :=  S ( F . . S ' LAST ) ; 

LAST  :=  L; 
end  PRINT; 

end  INTEGER_PRINT ; 

package  body  FLOAT_PRINT  is 

package  NUM_IO  is  new  FLOAT_IO ( NUMF ) ; 
use  NUM_IO; 

procedure  PRINT (FILE  :  in  FILE_TYPE ; 

LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUMF; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
S  :  STRING ( 1. . DEFAULT_FORE  +  DEFAULT_AFT  +  DEFAULT_EXP  +  2); 

L  :  NATURAL; 
begin 

PRINT (S,L, ITEM) ; 

PRINT (FILE, LINE, S(l. .L) , BRK ) ; 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILEJTYPE; 
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ITEM  :  in  NUMF; 

BRK  :  in  B REAK_T YP E  :  =*  BREAK)  is 

begin 

PRINT ( FILE, DEFAULT_LINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUMF; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  NUMF; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENTJDUTPUT , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUMF)  is 
S  :  STRING ( 1 . . DEFAULT_FORE  +  DEFAULT_AFT  +  DEFAULT_EXP  +  2 ) ; 

EXP  :  INTEGER; 

E_INDEX  :  NATURAL  :=  S' LAST  -  DEFAULT_EXP; 

DOT_INDEX  :  NATURAL  :=  DEFAULT_FORE  +  1; 

L  :  NATURAL; 

begin 

PUT ( S , ITEM) ; 

EXP  : -  INTEGER ' VALUE ( S ( E_INDEX+1 ..S'  LAST ) ) ; 
if  EXP  >=  0  then 

if  EXP  <=  DEFAULT_AFT-1  then 

S ( DOT_ INDEX . . D0T_INDEX+EXP-1 )  :=  S( D0T_INDEX+1 . . DOT_INDEX+EXP ) ; 

S(DOT_INDEX+EXP)  :=  '.'; 
for  I  in  E_INDEX . . S ' LAST  loop 
S(I)  :=  '  '  ; 
end  loop; 
end  if; 

else  —  EXP  <  0 

if  EXP  >=  -  (  DEFAULT_EXP  +  1  )  then 

S ( DEFAULT_EXP+2 .  .S' LAST)  :=  S ( 1 .  .S' LAST-DEFAULT_EXP— 1 ) ; 
for  I  in  1 . . DEFAULT_EXP+1  loop 
S(I)  :=  '  ' ; 
end  loop; 

E_INDEX  :=  S' LAST  +  1; 

DOT_INDEX  :=  DOT_INDEX  +  DEFAULT_EXP  +  1; 

L  :=  DOT_INDEX+EXP ; 

for  I  in  reverse  L+l. . DOT_INDEX  loop 
case  S(I-l)  is 

when  '  '  =>S(I)  :=  'O'; 

when  '-'  =>  S ( 1-2 )  :=  S(I)  :=  'O'; 

when  others  =>  S(I)  :=  S(I-l); 
end  case; 
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end  loop; 

S(L) 

case  S(L-l)  is 

when  '  '  ->  S(L-l)  :=  'O'; 

when  ->  S{L-2)  :=  ;  S(L 

when  others  *>  null; 
end  case; 
end  if; 
end  if; 

for  I  in  reverse  1. .E_INDEX-1  loop 
exit  when  S(I)  /=  'O'  or  else  S(I-l) 
S(I)  :=  '  ' ; 
end  loop; 

L  :=  TO' FIRST  -  1; 
for  I  in  S' RANGE  loop 
if  S(I)  /“  '  '  then 
L  L  +  1; 

TO(L)  :=  S ( I ) ; 
end  if; 
end  loop; 

LAST  :=  L; 
exception 

when  CONSTRAINT_ERROR  => 

raise  TEXT_IO . LAYOUT_ERROR ; 
end  PRINT; 

end  FLOAT_PRINT; 
end  TEXT  PRINT; 
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7.3  FUNCTION. ADS 


—  File:  function. ads 

—  ADA_SQL_FUNCTIONS  -  specially  tailored  for  UNITREP  demo  -  not  for  other  use 
--  12/18/88 

—  Fred  J.  Friedman 

—  RACOM  Computer  Professionals 

—  P.0.  Box  576 

—  Annandale,  VA  22003-1620 

—  (703)  560-6813  (703)  560-6799 

with  DATABASE; 

package  ADA_SQL_FUNCTIONS  is 

procedure  INITIATE_TEST; 

INTERNAL_ERROR , 

NO_DATA  :  exception; 


type  EXTENDED_INDICATOR  is  (  N0_INDICAT0R  ,  NULL_VALUE  ,  N0T_NULL  ) ; 

subtype  INDICATOR_VARIABLE  is  EXTENDED_INDICATOR 
range  NULL_VALUE  .  .  NOT_NULL; 


type  SQIi_0PERATI0N  is 


0_AVG 

/ 

0_MAX 

/ 

0_MIN 

0_SUM 

/ 

0_UNARY_PLUS 

t 

0_UNARY_MINUS 

/ 

0_PLUS 

0_MINUS 

t 

0_TIMES 

/ 

0_DIVIDE 

t 

0_EQ 

0_NE 

t 

0_LT 

/ 

0_GT 

f 

0_LE 

0_GE 

r 

0_BETWEEN 

/ 

0_AND 

t 

0_IS_IN 

0_0R 

t 

0_N0T 

/ 

0_LIKE 

r 

0_AMPERSAND 

0_SELEC 

f 

0_SELECT_DISTINCT 

r 

0_ASC 

/ 

0_DESC 

0_TABLE_C0LUMN_L I ST 

r 

0_C0UNT_STAR 

/ 

0_NULL_0P 

/ 

0_STAR 

0_N0T_IN 

t 

0_VALUES 

f 

0_DECLAR  )  ; 

type 

type 

type 

type 

type 

type 

type 

type 

type 

type 

type 


TYPED_SQL_OBJECT 

SQL_OBJECT 

TABLE_NAME 

FROM_CLAUSE 

INSERT_VALUE_L I ST 

INSERT_VALUE_LIST_STARTER 

SEARCH_COND I T I ON 

SELECT_LI ST 

VALUE_EXPRESSION 

VALUE_SPECIFICATION 

CURSOR  NAME 


is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 


NULL_SQL_OBJECT  :  constant  SQL_OBJECT; 
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NULL_SEARCH_CONDITION  :  constant  SEARCH_CONDITION; 

NULL_CURSOR_NAME  :  constant  CURSOR_NAME ; 

-  conversion  routines  for  user  types 

function  INTEGER_AND_ENUMERATION_CONVERT  (  VAR  :  DATABASE. INT  ) 
return  SQL_OBJECT; 

function  CONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  STANDARD . STRING  ) 
return  SQL_OB JECT ; 

-  column  and  table  name  routines 

function  COLUMN_OR_TABLE_NAME  (  GIVEN_NAME  :  STANDARD . STRING  ) 
return  SQL_OB JECT ; 

-  value  specification  routines 

function  INDICATOR_FUNCTION 

(  VALUE  :  SQL_OB JECT ; 

IND  :  INDICATOR_VARIABLE  :=  NOT_NULL  )  return  SQL_OBJECT; 

-  operation  routines 

function  BINARYjDPERATION 
(  GIVEN_OPERATION  :  SQL_OPERATION ; 

L  :  SQL_OB JECT ; 

R  :  SQL_OBJECT  ) 

return  SQL_OBJECT ; 

-  delete  routines 

procedure  DELETE 

(  FROM  :  in  TABLE_NAME; 

WHERE  :  in  SEARCH_CONDITION  : =  NULL_SEARCH_CONDITION  ) ; 

-  into  routines 

procedure  INTEGER_AND_ENUMERATION_INTO 

(  TARGET  :  out  DATABASE . INT ; 

INDICATOR  :  out  INDICATOR_VARI ABLE ; 

CURSOR  :  in  CURSOR_NAME  : =  NULL_CURSOR_NAME  ) ; 

procedure  INTEGER_AND_ENUMERATION_INTO 

(  TARGET  :  out  DATABASE. INT; 

CURSOR  :  in  CURSOR_NAKE  : =  NULL_CURSOR_NAME  ) ; 

procedure  CONSTRAINED_STRING_INTO 

(  TARGET  :  out  STANDARD . STRING ; 

LAST  :  out  STANDARD . NATURAL ; 

INDICATOR  :  out  INDICATOR  VARIABLE; 
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CURSOR  :  in  CURSOR_NAME  : -  NULL_CURSOR_NAME  ) ; 

procedure  CONSTRAINED_STRING_INTO 

(  TARGET  :  out  STANDARD . STRING ; 

LAST  ;  out  STANDARD. NATURAL; 

CURSOR  :  in  CURSOR_NAME  : -  NULL_CURSOR_NAME  ) ; 

-  insert  into  routines 

procedure  INSERT_INTO 

(  TABLE  :  in  TABLE_NAME; 

VALUES  :  in  INSERT_VALUE_LIST  ) ; 

function  VALUES  return  INSERT_VALUE_LIST_STARTER; 

-  select  statement  routines 

—  see  above  for  into  routines 
procedure  SELECT_LIST_SELECT 


SELECT_TYPE 

in 

SQL_OPERATION ; 

WHAT 

in 

SQL_OB JECT ; 

FROM 

in 

FROM_CLAUSE; 

WHERE 

in 

SEARCH_CONDITION  :=  NULL_SEARCH_COND I T I ON 

-  update  routines 

procedure  UPDATE_PROCEDURE 

(  TABLE  :  in  SQL_OB JECT ; 

SET  :  in  SQL_OB JECT ; 

WHERE  :  in  SEARCH_CONDITION  : =  NULL_SEARCH_COND I T I ON  ) ; 

-  conversion  routines  for  SQL  objects 

function  L_CONVERT  (  L  :  TYPED_SQL_OBJECT  )  return  SQL_OBJECT; 

function  R_CONVERT  {  R  :  TYPED_SQL_OBJECT  )  return  SQL_OBJECT 
renames  L_CONVERT,- 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPED_SQL_OB JECT ; 
package  CONVERT  is 


function 

L_ 

_CONVERT 

( 

L  ■ 

:  SQL. 

.OBJECT 

) 

return 

SQL. 

.OBJECT ; 

function 

R_ 

_CONVERT 

( 

R  : 

SQL. 

.OBJECT 

) 

return 

SQL. 

.OBJECT  renames 

L_CONVERT ; 

function 

CONVERT_R 

( 

R  : 

:  SQL. 

.OBJECT 

) 

return 

SQL. 

.OBJECT  renames 

L_CONVERT ; 

function 

_CONVERT 

( 

L  : 

:  TABLE_NAME 

) 

return 

SQL. 

.OBJECT ; 
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function  R_CONVERT  (  R 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L_CONVERT; 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  RECONVERT  (  R 
renames  L_CONVERT; 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L__CONVERT  ; 

function  CONVERT_R  (  R 

function  L__CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L_CONVERT; 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L_CONVERT; 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L_CONVERT; 

function  CONVERT_R  (  R 

function  L_CONVERT  (  L 

function  R_CONVERT  (  R 
renames  L  CONVERT; 


TABLE_NAME  )  return  SQL_OBJECT  renames  L_CONVERT; 
SQL_OBJECT  )  return  TABLE_NAME; 

FROM_CLAUSE  )  return  SQL_OBJECT; 

FROM_CLAUSE  )  return  SQL_OBJECT 

SQL_OBJECT  )  return  FROM_CLAUSE; 

INSERT_VALUE_LIST  )  return  SQL_OBJECT; 
INSERT_VALUE_LIST  )  return  SQL_OBJECT 

SQL_OBJECT  )  return  INSERT_VALUE_LIST; 
INSERT_VALUE_LIST_STARTER  )  return  SQL_OBJECT; 
INSERT_VALUE_LIST_STARTER  )  return  SQL_OBJECT 

SQL_OBJECT  )  return  INSERT_VALUE_LIST_STARTER; 
SEARCH_COND IT ION  )  return  SQL_OBJECT; 
SEARCH_CONDITION  )  return  SQL_OBJECT 

SQL_OBJECT  )  return  SEARCH_CONDITION; 

SEliECT_LIST  )  return  SQL_OBJECT; 

SELECT_LIST  )  return  SQL_OBJECT 

SQL_OBJECT  )  return  SELECT_LIST; 

VALUE_EXPRESSION  )  return  SQL_OBJECT; 
VALUE_EXPRESSION  )  return  SQLJOBJECT 

SQL_OBJECT  )  return  VALUE_EXPRESSION; 
VALUE_SPECIFICATION  )  return  SQL_OB JECT ; 
VALUE_SPECIFICATION  )  return  SQL_OBJECT 
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function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  VALUE_SPECIFICATION 
end  CONVERT; 


private 


type  DATABASE_NAME  is  access  STANDARD . STRING; 
type  ACCESS_STRING  is  access  STANDARD . STRING; 

type  SQL_VALUE_KIND  is  (  K_INTEGER  ,  K_FLOAT  ,  K_STRING  ); 

type  SQL_VALUE  (  KIND  :  SQL_VALUE_KIND  :=  K_INTEGER  )  is 
record 

case  KIND  is 

when  K_INTEGER  =*> 

INTEGER  :  DATABASE . INT ; 
when  K_FLOAT  => 

FLOAT  :  DATABASE . DOUBLEJPRECI SION; 
when  K_STRING  => 

STRING  :  ACCESS_STRING; 
end  case; 
end  record; 


type  SQL_OBJECT_KIND  is  (  NAME  ,  VALUE  ,  OPERATION  )  ; 


type 

type 

type 

type 

type 

type 

type 

type 

type 

type 

type 


SQL_OBJECT_RECORD  (  KIND  : 

TYPED_SQL_OBJECT  is  access 

SQL_OBJECT 

TABLE_NAME 

FROM_CLAUSE 

INSERT_VALUE_LI ST 

INSERT_VALUE_LIST_STARTER 

SEARCH_CONDIT ION 

SELECT_LI ST 

VALUE_EXPRESSION 

VALUE  SPECIFICATION 


SQL_OBJECT_KIND  ) ; 

SQL_OB JECT_RECORD ; 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_S QL_OB JECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED_SQL_OBJECT 
is  new  TYPED  SQL  OBJECT 


type  SQL_OBJECT_RECORD  (  KIND  :  SQL_OBJECT_KIND  )  is 
record 

ACROSS  :  SQL_CBJECT; 
case  KIND  is 
when  NAME  => 

NAME  :  DATABASE_NAME; 
when  VALUE  =*> 

INDICATOR  :  EXTENDED_INDICATOR; 

VALUE  :  SQL_VALUE; 

when  OPERATION  => 

OPERATION  :  SQL_OPERATION ; 

OPERANDS  :  SQL_OB JECT ; 
end  case; 
end  record; 
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type  CURSOR_NAME  is  new  TYPED_SQL_OB JECT ; 

NUIiL_SQL_OBJECT  :  constant  SQL_OBJECT  :=  null 

NULL_SEARCH_CONDITION  :  constant  SEARCH_CONDITION  :=  null 
NULL_CURSOR_NAME  :  constant  CURSOR_NAME  null 

end  ADA_SQL_FUNCTIONS / 
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7.4  FUNCTION. ADB 


—  File:  function. adb 

—  ADA_SQL_FUNCTIONS  -  specially  tailored  for  UNITREP  demo  -  not  for  other  use 
--  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIAEILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for : 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J .  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  TEXT_PRINT; 
use  TEXT_PRINT; 

package  body  ADA_SQL_FUNCTIONS  is 


BIDE_TABLE, 

COMMANDJTABLE  :  SQL_OBJECT  := 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_VALUES  ,  null  ) ; 
INTO_COLUMN  :  SQL_OBJECT; 
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INDENT  :  STANDARD . INTEGER ; 

package  INT__PRINT  renames  INTEGER_?RINT ; 

use  INT_PRINT ; 

LINE  :  LINE  TYPE; 


—  declarations  for  print  routines  (since  some  are  recursive  and  mutually 

—  recursive ) 


procedure 

SHOW_ 

VALUE_SPECIFICATION 

( 

S 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW_ 

,ALL_SET_FUNCT I ON 

( 

s 

:  in 

SQL_OBJECT 

)  ; 

procedure 

SHOW_ 

_VALUE_EXPRES  S ION 

( 

s 

:  in 

SQL_OBJECT 

) ; 

procedure 

SHOW_ 

_BETWEEN_PREDICATE 

( 

s 

:  in 

SQL_OBJECT 

): 

procedure 

SHOW_ 

,IN_VALUE_LI ST 

( 

s 

:  in 

SQL_OBJECT 

): 

procedure 

SHOW_ 

_LIKE_PREDICATE 

( 

s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW_ 

,SEARCH_CONDITION 

( 

s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW, 

,TABLE_EXPRESSION 

( 

s 

:  in 

SQL_OBJECT 

)  i 

procedure 

SHOW_ 

_QUERY_SPEC I F I CATION 

{ 

s 

:  in 

SQL_OBJECT 

): 

procedure 

SHOW, 

,SELECT_LI ST 

{ 

s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW_ 

.ORDER J3Y_CLAUSE 

( 

s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW_ 

_INSERT_VALUE_LI ST 

( 

s 

:  in 

SQL_OBJECT 

)i 

procedure 

SHOW, 

_SET_CLAUSES 

( 

s 

:  in 

SQL_OBJECT 

)/ 

procedure 

SHOW 

_COMPARISON_PREDICATE 

(  s  1 

:  in  SQL_OBJECT  ;  P  : 

in 

STANDARD . STRING 

)  i 

procedure 

SHOW 

,IN_PREDICATE 

(  S  i 

:  in  SQL_OBJECT  ;  P  : 

in 

STANDARD. STRING 

)i 

procedure  INITIATE_TEST  is 
begin 

CREATE_LINE  (  LINE  ,  79  ) ; 

SET_LINE  (  LINE  ) ; 

SET_CONTINUATION_INDENT  (  7  ) ; 
end  INITIATE_TEST ; 

—  conversion  routines  for  user  types 

function  INTEGER_AND_ENUMERATION_CONVERT  (  VAR  :  DATABASE. INT  ) 
return  SQL_OBJECT  is 
begin 

return  new 

SQL_OB JECT_RECORD '  (  VALUE  ,  null  ,  NO_INDICATOR  ,  (  K_INTEGER  ,  VAR  )  ) 
end  INTEGER_AND_ENUMERATION_CONVERT; 

function  CONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  STANDARD . STRING  ) 
return  SQL_OBJECT  is 
begin 

return  new 
SQL_OB JECT_RECORD ' 

(  VALUE  ,  null  ,  NO_INDICATOR , 
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(  K_STRING  ,  new  STANDARD . STRING '  (  VAR  )  )  ); 
end  CONSTRAINED_CHARACTER_STRING_CONVERT; 

-  column  and  table  name  routines 

function  C0LUMN_0R_TABLE_NAME  (  GIVEN_NAME  :  STANDARD . STRING  ) 
return  SQL_OBJECT  is 
begin 

return  new 
SQL_OBJECT_RECORD ' 

(  NAME  ,  null  ,  new  STANDARD . STRING '  (  GIVEN_NAME  )  ); 
end  COLUMN_OR_TABLE_NAME; 

-  value  specification  routines 

function  INDICATOR_FUNCTION 

(  VALUE  :  SQL_OB JECT ; 

IND  :  INDICATOR_VARIABLE  : =  NOT_NULL  )  return  SQL_OBJECT  is 

begin 

VALUE . INDICATOR  :=  IND; 
return  VALUE; 
end  INDICATOR_FUNCTION; 

function  COPY_NAME  (  OBJECT  :  SQL_OBOECT  )  return  SQL_OBJECT  is 
begin 

if  OBJECT  /=  null  and  then  OBJECT. KIND  -  NAME  then 
return  new  SQL_OB JECT_RECORD '  (  OBJECT. all  ); 
else 

return  OBJECT; 
end  if; 

end  COPY_NAME; 

function  BINARY_OPERATION 
(  GIVEN_OPERATION  :  SQL_OPERATION; 

L  :  SQL_OB JECT ; 

R  :  SQL_OBJECT  ) 

return  SQL_OBJECT  is 
LEFT  :  SQL_OB JECT  : =  COPY_NAME  (  L  ) ; 
begin 

LEFT. ACROSS  :=  R; 
return 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  GIVEN_OPERATION  ,  LEFT  ); 
end  B I NAR Y_OPERAT I ON ; 

-  subquery  routines 

function  NEW_TAIL  (  L  ,  R  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

if  R  *  null  then 
L. ACROSS  : = 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_NULL_0P  ,  null  ); 
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else 

L. ACROSS  R; 
end  if; 

return  L. ACROSS; 
end  NEW_TAIL; 

function  BUILD_SELECT 

(  SELECT_TYPE  :  SQL_OPERATION; 

WHAT  :  SQL_OB JECT ; 

FROM  :  FROM_CLAUSE; 

WHERE  ,  GROUP_BY  ,  HAVING  :  SQL_OBJECT  ) 

return  SQL_OBJECT  is 

F  :  SQL_OB JECT  : -  COPY_NAME  {  SQL_OB JECT  (  FROM  )  ) ; 

W  :  SQL_OB JECT  : -  COPY_NAME  (  WHAT  ) ; 

TAIL  :  SQL_OBJECT 
NEW_TAIL 
(  NEW_TAIL 

(  NEWJTAIL  (  F  ,  WHERE  )  ,  COPY_NAME  (  GROUP_BY  )  )  ,  HAVING  ) ; 

begin 

W. ACROSS  :=  F; 

return  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  SELECT_TYPE  ,  W  ) ; 
end  BUILD_SELECT; 

—  print  routines 

—  5.6.1  <value  specif ication> 

procedure  SHOW_VALUE_SPECIFICATION  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S. VALUE. KIND  is 

when  K_INTEGER  ->  PRINT  (  S . VALUE. INTEGER  ); 
when  K_FLOAT  »>  null;  —  PRINT  (  S . VALUE . FLOAT  ); 
when  R_STRING  ->  PRINT  (  &  S . VALUE . STRING . all  &  " ' "  ); 

end  case; 

if  S. INDICATOR  in  INDICATORJ/ARIABLE  then 

PRINT  (  "  "  S  INDICATOR_VARIABLE' IMAGE  (  S . INDICATOR  )  ); 

end  if; 

end  SHOW_VALUE_SPECIFICATION; 

—  5.8.3  <all  set  function > 

procedure  SHOW_ALL_SET_FUNCTION  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S. OPERATION  is 


when 

0_AVG 

-> 

PRINT 

( 

"AVG(  " 

)  ; 

when 

0_MAX 

-> 

PRINT 

( 

"MAX (  " 

); 

when 

0_MIN 

=  > 

PRINT 

( 

"MIN(  " 

); 

when 

0_SUM 

=  > 

PRINT 

( 

"SUM(  " 

) ; 

when 

others 

=  > 

raise 

INTERN AL_ 

ERROR; 

end  case; 

SHOW_VALUE_EXPRESSION  {  S . OPERANDS  ); 
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PRINT  (  "  )"  )  ; 
end  SHOW_MjL_SET_F UNCTION ; 

—  5.9.1  <value  expression> 


procedure  PARENTHESIZE_ADDING_OPERANDS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXPRE S S ION  (  S  ); 

PRINT  (  P  ) ; 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S . ACROSS . OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  => 

PRINT  (  "(  "  ) ; 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 

PRINT  (  "  )"  ) ; 
when  others  => 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 
end  if; 

end  PARENTHESIZE_ADDING_OPERANDS; 


procedure  PARENTHESIZE_MULTIPLYING_OPERANDS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  ) 

begin 

if  S . KIND  -  OPERATION  then 
case  S. OPERATION  is 

when  0_UNARY_MINUS  j  0_PLUS  |  0_MINUS  => 

PRINT  (  "(  "  ) ; 

SHOW_VALUE_EXPRESSION  (  S  ); 

PRINT  (  "  ) "  ) ; 
when  others  => 


SHOW_VALUE_EXPRESSION  (  S  ) ; 
end  case; 
else 


SHOW_VALUE_EXPRESSION  (  S  ) ; 
end  if; 


PRINT  (  P  ); 

if  S . ACROSS . KIND  =  OPERATION  then 


is 


case  S . ACROSS . OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  |  0_TIMES  |  0_DIVIDE 
PRINT  (  "(  "  ) ; 

SHOW_VALUE_EXPRES SION  (  S. ACROSS  ); 

PRINT  (  "  ) "  )  ; 
when  others  => 

SHOW_V ALUE_EXP RES S I ON  (  S . ACROSS  ) ; 
end  case; 
else 


SHOW_VALUE_EXPRESSION  (  S . ACROSS  ) ; 
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end  if; 

end  PARENTHESIZE_MULTIPLYING_OPERANDS; 

procedure  SHOW_VALUE_EXPRESSION  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S.KIND  is 
when  VALUE  => 

SHOW_VALUE_SPECIFICATION  (  S  ); 
when  NAME  *> > 

PRINT  (  S . NAME . all  ) ; 
when  OPERATION  =*> 
case  S. OPERATION  is 

when  0_AVG  |  0_MAX  |  0_MIN  |  0_SUM  => 
SHOW_ALL_SET_FUNCTION  (  S  ); 
when  0_C0UNT_STAR  => 

PRINT  (  " COUNT ( * ) "  ); 
when  0_UNAR Y_P LUS  => 

SHOW_VALlTE_EXPRESSION  (  S  .  OPERANDS  )  ; 
when  0_UNARY_MINUS  =■> 

PRINT  (  "  -  "  ) ; 

if  S . OPERANDS . KIND  =  OPERATION  then 
case  S. OPERANDS. OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  |  0_TIMES  | 
PRINT  ("("); 

SHOW_VALUE_EXPRESSION  <  S. OPERANDS  ); 

PRINT  (  "  )"  ) ; 

when  others  =>  SHOW_VALUE_EXPRESSION  (  S . OPERANDS 
end  case; 
else 

SHOW_V ALUE_EXP RE S S I ON  (  S . OPERANDS  ); 
end  if; 

when  OJPLUS  => 

PARENTHESIZE_ADDING_OPERANDS  (  S . OPERANDS  ,  "  +  "  ) ; 
when  0_MINUS  =*> 

PARENTHESIZE_ADDING_OPERANDS  (  S. OPERANDS  ,  "  -  "  ); 
when  0_TIMES  => 

P ARENTHE S I Z E_MULT IPLYING_0P E RAND S  (  S . OPERANDS  ,  "  *  " 
when  0_DIVIDE  => 

PARENTHESIZE_MULTIPLYING_OPERANDS  (  S . OPERANDS  ,  ”  /  ” 
when  others  =>  raise  INTERNAL_ERROR; 
end  case; 
end  case; 

end  SHOW_VALUE_EXPRESS I ON ; 

—  5.11.1  Comparison  predicate> 

procedure  SHOW_COMPARISON_PREDICATE 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXPRESSION  (  S  ) ; 

PRINT  (  P  )  ; 


DIVIDE 


)  ! 
): 
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if  S.  ACROSS.  KIND  =*  OPERATION  then 
case  S . ACROSS . OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  »> 

SHOW_QUERY_SP EC I F I CAT I ON  (  S . ACROSS  ); 
when  others  -> 

SHOW_VALUE_EXPRES SION  (  S. ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRE S SION  (  S. ACROSS  ); 
end  if; 

end  SHOW_COMPARISON_PREDICATE; 

—  5.12.1  <between  predicate > 

procedure  SHOW_B ETWEEN_P RED I C AT E  (  S  :  in  SQL_OBJECT  )  is 

OPERAND  :  SQL_OBJECT  :=  S . ACROSS . OPERANDS ;  —  first  operand  of  AND 
begin 

SHOW_V  ALUE_EXP  RE  S  S I ON  (  S  )  ; 

PRINT  (  "  BETWEEN  "  ) ; 

SHOW_VALUE_EXPRESSION  (  OPERAND  ) ; 

PRINT  (  "  AND  "  ) ; 

SHOW_VALUE_EXPRESSION  (  OPERAND . ACROSS  ); 
end  SHOW_B  ETWEEN_P  RED I CAT E ; 

—  5.13.1  <in  predicate> 

procedure  SHOW_IN_PREDICATE 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

PRINT  (  P  ) ; 

SHOW_V ALUE_EXP  RE  S  S I ON  (  S  )  ; 

PRINT  (  "  IN  "  )  ; 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  => 

SHOW_QUERY_SPECIFICATION  (  S . ACROSS  ) ; 
return ; 

when  others  => 
null  ; 
end  case; 
end  if; 

PRINT  (  "(  "  );  SHOW_IN_VALUE_LIST  (  S. ACROSS  );  PRINT  (  "  )"  ); 
end  SHOW_IN_PREDICATE; 

—  5.13.2  <in  value  list> 

procedure  SHOW_IN_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  => 

SHOW_V ALUE_S  P  EC I F I CAT I ON  (  S  ) ; 
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when  OPERATION  -> 

if  S. OPERATION  /-  0_0R  then 
raise  INTERN AL_ERROR ; 
end  if; 

SHOW_IN_VALUE_LIST  (  S. OPERANDS  ); 

PRINT  (  ",  "  )  ; 

SHOW_IN_VALUE_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  *> 

raise  INTERN AL_ERROR ; 
end  case; 

end  SHOW_IN_VALUE_LIST; 

—  5.14.1  <like  predicate> 

procedure  SHOW_LIKE_PREDICATE  (  S  :  in  SQL_OBJECT  )  is 

P  :  ACCESS_STRING  :=  S . ACROSS . VALUE . STRING;  —  must  be  of  right  type 
begin 

PRINT  (  S . NAME . all  ) ;  PRINT  (  "  LIKE  "  ) ; 

-  for  I  in  P' RANGE  loop 
case  P(I)  is 

when  =■>  P(I)  :=  ; 

when  '%'  =>  P(I)  := 

when  others  =>  null; 

end  case; 
end  loop; 

SHOW_VALUE_SPECIFICATION  (  S. ACROSS  ); 
end  SHOW_LIKE_PREDICATE; 

—  5.18.1  <search  condition> 

procedure  PARENTHESIZE_RELATIONAL_OPERATORS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 
OPERAND  :  SQL_OBJECT  S. OPERANDS; 

begin 

case  OPERAND . OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  =  > 

if  OPERAND . OPERATION  /=  S. OPERATION  then 

PRINT  (  " (  "  ) ;  SHOW_SEARCH_CONDITION  (  OPERAND  ) ;  PRINT  (  "  ) " 

else 

SHOW_SEARCH_COND I T I ON  (  OPERAND  ) ; 
end  if; 

when  others  =>  SHOW_SEARCH_CONDITION  (  OPERAND  ); 
end  case; 

PRINT_LINE;  PRINT  (  P  ) ; 

OPERAND  OPERAND . ACROSS ; 

case  OPERAND . OPERATION  is  —  again,  must  be  operation 
when  0_AND  |  0_0R  «> 

PRINT  (  " (  "  ) ;  SHOW_SEARCH_CONDITION  (  OPERAND  ) ;  PRINT  (  "  ) "  ) 

when  others  => 

SHOW_SEARCH_CONDITION  (  OPERAND  ) ; 
end  case; 
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end  PARENTHESIZE_RELATIONAL_OPERATORS; 

procedure  SHOW_SEARCH_CONDITION  (  S  :  in  SQL_OBJECT  )  is 
begin 


case  S . 

,  OPERATION 

is 

when 

0_EQ 

-> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

t 

n  m  n 

)/ 

when 

0_NE 

-> 

SHOW_COMPARI SON_PREDICATE 

( 

S . OPERANDS 

t 

n  n 

) ; 

when 

0_LT 

=  > 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

/ 

i»  ^  »» 

); 

when 

0_GT 

-> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

/ 

If  y  if 

); 

when 

0_LE 

=  > 

SHOW_C  OMP  AR I SON_P RED I CATE 

( 

S. OPERANDS 

/ 

It  ^  g,  If 

); 

when 

0_GE 

-> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

f 

If  y  =  If 

); 

when 

0_BETWEEN 

-> 

SHOW_BETWEEN_PREDICATE 

( 

S . OPERANDS 

) 

t 

when 

0_IS_IN 

=  ) 

SHOW_IN_PREDICATE 

( 

S . OPERANDS 

t 

""  )/ 

when 

0_N0T_IN 

=  > 

SHOW_IN_PREDICATE 

( 

S . OPERANDS 

/ 

"NOT" 

>; 

when 

0_LIKE 

=*> 

SHOW_LIKE_PREDICATE 

( 

S . OPERANDS 

) 

t 

when 

0_AND 

=  > 

P ARENTHES I ZE_RELATIONAL_OPERATORS  (  S  , 

"AND 

"  )/ 

when 

when 

0_0R 

0  NOT  => 

=  > 

P ARENTHES I Z  E_RELATI ONAL_OPERATORS  (  S  , 

"OR 

"  ); 

PRINT  (  "NOT  "  ) ; 

case  S . OPERANDS . OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  =»> 

PRINT  (  " (  "  )  ; 

SHOW_SEARCH_CONDITION  (  S . OPERANDS  ) ; 

PRINT  (  "  )"  ) ; 
when  others  **> 

SHOW_S EARCH_C OND I T I ON  (  S . OPERANDS  ) ; 
end  case; 

when  others  =*>  raise  INTERN AL_ERROR ; 
end  case; 

end  SHOW_SEARCH_CONDITION ; 

—  5.19.1  <table  expression) 

procedure  SHOW_TABLE_EXPRESSION  (  S  :  in  SQL_OBJECT  )  is 
CLAUSE  :  SQL_OBJECT  :=  S. ACROSS; 
begin 

PRINT  (  "FROM  "  );  SHOW_SELECT_LIST  (  S  ); 

if  CLAUSE . OPERATION  /=  0_NULL__0P  then  —  WHERE  must  have  operation  on  top 
PRINT_LINE;  PRINT  (  "WHERE  "  );  SHOW_SEARCH_CONDITION  (  CLAUSE  ); 
end  if; 

CLAUSE  :=  CLAUSE. ACROSS ; 

if  CLAUSE. KIND  /=  OPERATION  or  else  CLAUSE . OPERATION  /=  0_NULL_0P  then 
PRINT_LINE;  PRINT  (  "GROUP  BY  "  ) ;  SHOW_SELECT_LIST  (  CLAUSE  ) ; 
end  if; 

CLAUSE  :=  CLAUSE. ACROSS; 

if  CLAUSE . OPERATION  /-  0_NULL_0P  then  —  same  as  WHERE 

PRINTLINE;  PRINT  (  "HAVING  "  )  ;  SHOW_SEARCH_CONDITION  (  CLAUSE  ); 
end  if; 

end  SHOW_TABLE  ^EXPRESSION; 

—  5.25.1  <query  specification) 
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procedure  SHOW_QUERY_SPECIFICATION  (  S  :  in  SQL_OBJECT  )  is 
CLAUSE  :  SQL_OBJECT  :  =  S.  OPERANDS; 
begin 

INDENT  :«  INDENT  +  5; 
if  INDENT  >=  0  then 

SET_INDENT  (  INDENT  ) ; 
end  if; 

PRINTLINE; 

INDENT  : =  INDENT  +  2; 
if  INDENT  >  0  then 

PRINT  (  "(  SELECT  "  ); 
else 

PRINT  (  " SELECT  "  ) ; 
end  if; 

SET_INDENT  (  INDENT  ) ; 
case  S. OPERATION  is 

when  0_SELEC  =>  null; 

when  0_SELECT_D I ST I NCT  =>  PRINT  (  "DISTINCT  "); 
when  others  =>  raise  INTERNAL_ERROR; 

end  case; 

SHOW_SELECT_LIST  (  CLAUSE  ) ; 

PRINT_LINE; 

SHOW_T AB LE_EXPRES S I ON  (  CLAUSE . ACROSS  ); 

INDENT  INDENT  -  7; 
if  INDENT  >=  0  then 
PRINT  (  "  )"  ) ; 

SET_INDENT  {  INDENT  ); 
end  if; 

end  SHOW_QUERY_SPECIFICATION; 

—  5.25.2  <select  list> 

procedure  SHOW_SELECT_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 

when  NAME  |  VALUE  => 

SHOW_VALUE_EXPRESSION  (  S  ) ; 
when  OPERATION  => 

case  S. OPERATION  is 
when  0_STAR  => 

PRINT  (  )  ; 

When  0_AMPERSAND  => 

SHOW_SELECT_L 1ST  (  S . OPERANDS  ); 

PRINT  (  ",  "  ) ; 

SHOW_SELECT_LIST  (  S  .  OPERANDS . ACROSS  ); 
when  others  =*> 

SHOW_VALUE_EXPRESSION  (  S  ) ; 
end  case; 
end  case; 

end  SHOW  SELECT_LIST ; 
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—  8.3.5  <order  by  clause> 

procedure  SHOW_ORDER_BY_CLAUSE  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 

when  NAME  |  VALUE  => 

SHOW_VALUE_EXPRES SION  (  S  )  ; 
when  OPERATION  => 
case  S . OPERATION  is 
when  0_AMPERSAND  => 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS  ); 

PRINT  (  ",  "  ) ; 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS . ACROSS  ) ; 
when  0_ASC  => 

SHOW_VALUE_EXPRESSION  (  S . OPERANDS  ) ; 
when  0_DESC  => 

SHOW_VALUE__EXPRESSION  (  S  .  OPERANDS  )  ; 

PRINT  (  "  DESC"  ) ; 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 
end  case; 

end  SHOW_ORDER_BY_CLAUSE; 

—  8.7.3  <insert  value  list> 

procedure  SHOW_INSERT_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  => 

SHOW_VALUE_SPECIFICATION  (  S  ) ; 
when  OPERATION  => 
case  S. OPERATION  is 
when  0_AND  => 

SHOW_INSERT_VALUE_LIST  {  S . OPERANDS  ); 

PRINT  (  ",  "  )  ; 

when  0_LE  => 
null; 

when  others  => 

raise  INTERNAL_ERROR ; 
end  case, 

SHOW_INSERT_VALUE_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  => 

raise  INTERNAL_ERROR; 
end  case; 

end  SHOW_INSERT_VALUE_LIST; 

—  8.11.2  <set  clause) 

procedure  SHOW_SET_CLAUSES  (  S  :  in  SQL_OBJECT  )  is 
begin 
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case  S. OPERATION  is  —  must  be  operation 
when  0_AND  -> 

SHOW_SET_CLAUSES  (  S. OPERANDS  );  PRINT  (  n , "  );  PRINT_LINE; 
SHOW_SET_CLAUSES  <  S . OPERANDS . ACROSS  ); 
when  0_LE  «* > 

PRINT  (  S . OPERANDS . NAME . all  &  "  -  "  }  ; 

S HOW_V ALUE_EXP RE S S I ON  (  S . OPERANDS . ACROSS  ) ; 
when  others  *■> 

raise  INTERN AL_ERROR ; 
end  case; 

end  SHOW_SET_CLAUSES ; 

—  delete  routines 

function  DEMO_TABLE  (  TABLE  :  TABLE_NAME  )  return  SQL_OBJECT  is 
begin 

if  TABLE . NAME . all  =  "BIDE"  then 
return  B IDE_TABLE ; 
else 

return  COMMANDJTABLE ; 
end  if, 

end  DEMOJTABLE; 

function  ROW_BEFORE_DESIRED_ONE 
(  TABLE  :  TABLE_NAME; 

WHERE  :  SEARCH_CONDITION  )  return  SQL_OBJECT  is 
KEY  :  ACCESS_STRING  :=  WHERE. OPERANDS . ACROSS . VALUE . STRING; 

PREVIOUS_ROW  :  SQL_OBJECT  : =  DEMO_TABLE  (  TABLE  ) ; 

CURRENT_ROW  :  SQL_OBJECT; 
begin 
loop 

CURRENT_ROW  :=  PREYIOUS_ROW . OPERANDS ; 
if  CURRENT_ROW  =  null  then 

PRINT  (  ******  NO  DATA  ******  );  PRINTLINE; 
raise  NO_DATA ; 

elsif  CURRENT_ROW. ACROSS. VALUE. STRING. all  =  KEY. all  then 
return  PREVIOUS_ROW; 
end  if; 

PREVIOUS_ROW  :=  CURRENT_ROW; 
end  loop,- 

end  R0W_BEF0RE_DE3IRED_0NE; 

procedure  DELETE 

(  FROM  :  in  TABLE_NAME; 

WHERE  :  in  SEARCH_CONDITION  :=  NULL_SEARCH_CONDITION  )  is 
PREVIOUS_ROW  :  SQL_OB JECT ; 
begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  "DELETE  ’’  S  FROM .  NAME .  all  ); 
if  WHERE  /=*  null  then 

INDENT  :=  0;  PRINT_LINE;  PRINT  (  "WHERE  "  ); 

SHOW_SEARCH_COND IT ION  (  SQL_OBJECT  (  WHERE  )  ) ; 
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PRINT_LINE; 

PREVIOUS_ROW  : -  ROW_BEFORE_DES I RED_ONE  (  FROM  ,  WHERE  ) ; 
PREVIOUS_ROW. OPERANDS  PREVIOUS_ROW. OPERANDS . OPERANDS ; 

else 

PRINT_LINE; 
end  if; 
exception 

when  NO_DATA  »>  null; 

when  others  »>  raise  INTERNAL_ERROR ; 
end  DELETE; 


—  into  routines 


function  INDICATOR_VALUE  (  VALUE  :  SQL_OBJECT  )  return  INDICATOR_VARIABLE  is 
begin 

if  VALUE . INDICATOR  =  NO_INDICATOR  then 
return  NOT_NULL; 
else 

return  VALUE . INDICATOR; 
end  if; 

end  INDICATOR_VALUE ; 

procedure  SHOW_INTO  is 
begin 

PRINT  (  "INTO  returning  "  );  SHOW_VALUE_SPECIFICATION  (  INTO_COLUMN  ); 
PRINTLINE;  INTO_COLUMN  :=  INTO_COLUMN . ACROSS ; 
end  SHOW_INTO; 

procedure  INTEGER_AND_ENUMERATION_INTO 

(  TARGET  :  out  DATABASE . INT ; 

INDICATOR  :  out  INDICATOR_VARIABLE ; 

CURSOR  :  in  CURSOR_NAME  :=  NULL_CURSOR_NAME  )  is 

begin 

TARGET  : =  INTO_COLUMN . VALUE . INTEGER ; 

INDICATOR  :=  INDICATOR_VALUE  (  INTO_COLUMN  ); 

SHOW_INTO; 

end  INTEGER_AND_ENUMERATION_INTO; 


procedure  INTEGER_AND_ENUMERATION_INTO 

(  TARGET  :  out  DATABASE . INT ; 

CURSOR  :  in  CURSOR_NAME  :=  NULL_CURSOR_NAME  )  is 

begin 

TARGET  : =  INTO_COLUMN . VALUE . INTEGER ; 

SHOW_INTO; 

end  INTEGER_AND_ENUMERATION_INTO; 


procedure  CONSTRAINED_STRING_INTO 


( 


TARGET 

LAST 

INDICATOR 

CURSOR 


out  STANDARD. STRING; 
out  STANDARD. NATURAL; 
out  INDICATOR_VARIABLE; 

in  CURSOR_NAME  :=  NULL_CURSOR_NAME  )  is 
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begin 

TARGET  : =  INTO_COLUMN . VALUE . STRING . all ; 

LAST  :=*  TARGET 'LAST; 

INDICATOR  : -  INDICATOR_VALUE  (  INTO_COLUMN  ) ; 

SHOW_INTO ; 

end  CONSTRAINED_STRING_INTO; 

procedure  CONSTRAINED_STRING_INTO 

(  TARGET  :  out  STANDARD . STRING ; 

LAST  :  out  STANDARD. NATURAL; 

CURSOR  :  in  CURSOR_NAME  :=  NULL_CURSOR_NAME  )  is 

begin 

TARGET  :=  INTO_COLUMN . VALUE . STRING. all; 

LAST  :=  TARGET 'LAST ; 

SHOW_INTO; 

end  CONSTRAINED_STRING_INTO; 


—  insert  into  routines 


procedure  RECURSIVELY_ADD_COLUMN 

(  PREVIOUS_LAST_COLUMN  :  in  out  SQL_OBJECT; 

VALUES  :  in  SQL_OBJECT  )  is 

begin 

case  VALUES. KIND  is 
when  VALUE  => 

PREVIOUS_LAST_COLUMN. ACROSS  :«  new 
SQL_OB JECT_RECORD ' 

(  VALUE  ,  null  ,  VALUES . INDICATOR  ,  VALUES . VALUE  ); 
PREVIOUS_LAST_COLUMN  :=  PREVIOUS_LAST_COLUMN . ACROSS ; 
when  OPERATION  => 

case  VALUES . OPERATION  is 
when  0_AND  => 

RECURS IVELY_ADD_COLUMN  (  PREVIOUS_LAST_COLUMN  ,  VALUES . OPERANDS  ) 
when  0_LE  => 
null ; 

when  others  -> 

raise  INTERNAL_ERROR ; 
end  case,- 

RECURSIVELY_ADD_COLUMN 

(  PREVIOUS__LAST_COLUMN  ,  VALUES . OPERANDS . ACROSS  ); 
when  others  => 


raise  INTERNAL_ERROR; 
end  case; 

end  RECURS I VELY_ADD_COLUMN; 


procedure  MAKE_DATABASE_ROW 

(  VALUES  :  in  INSERT_VALUE_LI ST ; 

TABLE  :  in  SQL_OBJECT  )  is 
LAST_COLUMN  :  SQL_OBJECT  := 

new  SQL_OB <TECT_RECORD '  (  OPERATION  ,  null  ,  0_VALUES  ,  TABLE . OPERANDS  ); 
begin 
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TABLE . OPERANDS  :=  LAST_COLUMN; 

RECURS I VELY_ADD_COLUMN  (  LAST_COLUMN  ,  SQL_OBJECT  (  VALUES  )  ); 
end  MAKE_DATAB ASE_ROW ; 

procedure  INSERT_INTO 

(  TABLE  :  in  TABLE_NAME; 

VALUES  :  in  INSERT_VALUE_LIST  )  is 

begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  "INSERT  INTO  "  ); 
if  TABLE. KIND  =  NAME  then 
PRINT  (  TABLE . NAME . all  ) ; 
else  —  must  be  0_TABLE_COLUMN_LI ST 
PRINT  (  TABLE. OPERANDS. NAME. all  ); 

PRINT  (  "(  "  ) ; 

SHOW_SELECT_LIST  (  TABLE . OPERANDS . ACROSS  ); 

PRINT  (  "  ) "  ) ; 
end  if; 

PRINTLINE; 

case  VALUES . OPERATION  is  —  must  be  an  operation 
when  0_SELEC  |  0_SELECT_DISTINCT  => 

INDENT  : =  -7 ;  SHOW_QUERY_SPECIFICATION  (  SQL_OBJECT  (  VALUES  )  ) ; 
when  0_LE  |  0_AND  => 

PRINT  (  "VALUES  (  "  )  ; 

SHOW_INSERT_VALUE_LIST  (  SQLJDBJECT  (  VALUES  )  ); 

PRINT  (  "  )"  ); 

MAKE_DATABASE_ROW  (  VALUES  ,  DEMO_TABLE  (  TABLE  )  ); 
when  others  => 

raise  INTERN AL_ERROR ; 
end  case; 

PRINT_LINE; 

exception 

when  others  =>  raise  INTERNAL_ERROR ; 
end  INSERT_INT O; 

function  VALUES  return  INSERT_VALUE_LIST_STARTER  is 
begin 

return  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_VALUES  ,  null  ) ; 
end  VALUES; 

—  select  statement  routines 


function  SECOND_COLUMN  (  TABLE  :  TABLE_NAME  ;  WHERE  :  SEARCH_CONDITION  ) 
return  SQL_OBJECT  is 
begin 
return 

ROW_BEFORE_DESIRED_ONE  (  TABLE  ,  WHERE  )  .  OPERANDS  .  ACROSS  .  ACROSS; 
end  SECOND_COLUMN; 

procedure  SHOW_SELECT  (  S  :  in  SQL_OBJECT  )  is 
begin 

BLANK_LINE;  INDENT  :=  -7; 
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SHOW_QUERY_SPEC I F I CAT I ON  (  S  ); 
PRINT_LINE; 
exception 

when  others  ->  raise  INTERNAL_ERROR; 
end  SHOW_SELECT; 

procedure  SELECT_LIST_SELECT 


SELECTJTYPE 

in 

SQL_OPERATION; 

WHAT 

in 

SQL_0B JECT ; 

FROM 

in 

FROM_CLAUSE; 

WHERE 

in 

SEARCH_CONDITION  :=  NULL_ S EARCH_C OND I T I ON  )  is 

begin 

SHOW_SELECT 
(  BUILD_SELECT 

(  SELECTJTYPE  ,  WHAT  ,  FROM  ,  SQL_OBJECT  (  WHERE  ) ,  null  ,  null  )  ) ; 
INTO_COLUMN  :  »  SECOND_COLUMN  (  TABLE_NAME  (  FROM  )  ,  WHERE  ) ; 
end  SELECT_LIST  SELECT; 


—  update  routines 

procedure  RECURS IVELY_SET_VALUES 

(  COLUMN  :  in  out  SQL_OBJECT  ;  SET  :  in  SQL_OBJECT  )  is 

begin 

case  SET. OPERATION  is  —  must  be  operation 
when  0_AND  «> 

RECURS I VEL Y_SET_VALUES  (  COLUMN  ,  SET . OPERANDS  ) ; 
RECURSIYELY_SET_VALUES  (  COLUMN  ,  SET . OPERANDS . ACROSS  ); 
when  0_LE  =*> 

COLUMN . INDICATOR  : =  SET . OPERANDS . ACROSS . INDICATOR; 

COLUMN . VALUE  : =  SET . OPERANDS . ACROSS . VALUE ; 

COLUMN  :=  COLUMN. ACROSS; 

when  others  =*> 

raise  INTERNAL_ERROR ; 
end  case; 

end  RECURSIVELY  SET  VALUES; 


procedure  UPDATE_KEYED_ROW 

(  TABLE  :  in  SQL_OBJECT; 

WHERE  :  in  SEARCH_CONDITION; 

SET  :  in  SQL_OBJECT  )  is 

CURRENT_COLUMN  :  SQL_OBJECT  := 

SECOND_COLUMN  (  TABLE_NAME  (  TABLE  )  ,  WHERE  ) ; 
begin 

RECURS I VEL Y_SET_VALUES  (  CURRENT _COLUMN  ,  SET  ) ; 
end  UPDATE_KEYED_ROW; 

procedure  UP  DAT  E_P  ROCEDURE 

(  TABLE  :  in  SQL_OB JECT ; 

SET  :  in  SQL_OB JECT ; 

WHERE  :  in  SEARCH_COND I T I ON  : =  NULL_SEARCH_CONDITION  )  is 

begin 
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BLANK_LINE;  SET_INDENT  (  0  ) ; 

PRINT  (  "UPDATE  "  &  TABLE . NAME . all  ); 

PRINTLINE;  PRINT  {  "SET  "  )/  SET_INDENT  (  4  ); 

SHOW_SET_CLAUSES  (  SET  ); 
if  WHERE  /-  null  then 

INDENT  0/  SET_INDENT  (  0  );  PRINT_LINE;  PRINT  (  "WHERE  "); 
SHOW_SEARCH_COND  I T I  ON  (  SQL_OBJECT  (  WHERE  )  )  ;  PRINTLINE; 
UPDATE_KEYED_ROW  (  TABLE  ,  WHERE  ,  SET  ); 
else 

PRINTLINE; 
end  if; 
exception 

when  N0_DATA  =»>  null; 

when  others  =>  raise  INTERN AL_ERR0R ; 
end  UPDATE_PROCEDURE; 

package  body  CONVERT  is 

function  L_C0NVERT  (  L  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

return  L; 
end  L_C0NVERT; 

function  L_C0NVERT  (  L  :  TABLE_NAME  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  )  ; 
end  L_C0NVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TABLE_NAME  is 
begin 

return  TABLE_NAME  (  R  ) ; 
end  C0NVERT_R; 

function  L_C0NVERT  (  L  :  FROM_CLAUSE  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_C0NVERT; 

function  C0NVERT_R  (  R  :  SQL_OBJECT  )  return  F R0M_C LAU S E  is 
begin 

return  FR0M_CLAU SE  (  R  ) ; 
end  C0NVERT_R; 

function  L_C0NVERT  (  L  :  INSERT_VALUE_LIST  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_C0NVERT; 

function  C0NVERT_R  (  R  :  SQL_OBJECT  )  return  INSERT_VALUE_LIST  is 
begin 

return  INSERT_VALUE_L I ST  (  R  ) ; 
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end  CONVERT_R; 

function  L_CONVERT  (  L  :  INSERT_VALUE_LIST_STARTER  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  INSERT_VALUE_LIST_STARTER  is 
begin 

return  INSERT_VALUE_LIST_STARTER  (  ~R  ) ; 
end  CONVERT_R; 

function  L_CONVERT  (  L  :  SEARCH_CONDITION  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  SEARCH_CONDITION  is 
begin 

return  SEARCH_CONDITION  (  R  ) ; 
end  CONVERTER; 

function  L_CONVERT  (  L  :  SELECT_LI ST  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERTER  (  R  :  SQL_OBJECT  )  return  SELECT_LI ST  is 
begin 

return  SELECT_LIST  (  R  ); 
end  CONVERT_R; 

function  L_CONVERT  (  L  :  VALUE_EXPRESSION  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  VALUE_EXPRESSION  is 
begin 

return  VALUE_EXPRESSION  (  R  ) ; 
end  CONVERT_R; 

function  L_CONVERT  (  L  :  VALUE_SPECIFICATION  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  VALUE_SPECIFICATION  is 
begin 

return  VALUE_SPECIFICATION  (  R  ) ; 
end  CONVERT_R; 
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end  CONVERT; 

—  conversion  routines  for  SQL  objects 

function  L_CONVERT  (  L  :  TYPED_SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPED_SQL_OBJECT  is 
begin 

return  TYPED_SQL_OBJECT  (  R  )  ; 
end  CONVERTJR; 

end  ADA_SQL_FUNCTIONS ; 
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7.5  DBTYPES.ADS 


—  File:  dbtypes.ads 

—  DATABASE_TYPES 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 

—  Prepared  for: 

—  Institute  for  Defense  Analyses 

—  1801  N.  Beauregard  Street 

—  Alexandria,  VA  22311 

—  Prepared  by : 

Fred  J.  Friedman 

—  RACOM  Computer  Professionals 
P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


package  DATABASE_TYPES  is 
package  ADA_SQL  is 


subtype 

X_ 

_DATE 

is 

INTEGER 

range 

1  .  . 

8; 

subtype 

X_ 

.REVAL 

is 

INTEGER 

range 

1  .  . 

1; 

subtype 

x_ 

_SHORT_NAME 

is 

INTEGER 

range 

1  .  . 

30; 

subtype 

x_ 

_UIC 

is 

INTEGER 

range 

1  .  . 

6; 

subtype 

x_ 

_ULC 

is 

INTEGER 

range 

1  .  . 

3; 

subtype 

x_ 

_UTC 

is 

INTEGER 

range 

1  .  . 

5; 
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type 

T_DATE 

is 

array 

type 

T_REVAL 

is 

array 

type 

T_SECUR 

is 

(  u  , 

type 

T_SHORT_NAME 

is 

array 

type 

T_TPSN 

is 

range 

type 

T_UIC 

is 

array 

type 

T_ULC 

is 

array 

type 

T_UTC 

is 

array 

end  ADA_SQL; 

' 

end  DATABASEJTYPES ; 


(  X_DATE  )  of  CHARACTER; 

(  X_REVAL  )  of  CHARACTER; 

C  ,  S  ,  T  ); 

(  X_SHORT_NAME  )  of  CHARACTER; 
0  ..  9_999_999; 

(  X_UIC  )  of  CHARACTER; 

{  X_ULC  )  of  CHARACTER; 

(  X_UTC  )  of  CHARACTER; 
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7.6  GENP ACK. ADA 


—  File:  genpack.ads 

—  DATABASE_CARD_A_ADA_SQL 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J.  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  ADA_SQL_FUNCTIONS ,  DATABASE_TYPES ; 
package  DATABASE_CARD_A_ADA_SQL  is 

NO_DATA  :  exception  renames  ADA_SQL_FUNCTIONS . NO_DATA; 

procedure  INITIATE_TEST  renames  ADA_SQL_FUNCTIONS . INITIATE_TEST; 

package  ADA_SQL  is 

package  DATABASE_DEFINITION_PACKAGE  is 
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package  B I DE_P ACKAGE  is 

type  TABLE_NAME  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT / 

type  SET_CLAUSE  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

package  DATABASE_TYPES  is 

type  COLUMN_NAME_T_DATE  is  new 
ADA  SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 


type  COLUMN_NAME_T_REVAL  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

type  VALUE_EXP  RE  SSI ON_T_RE VAL  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

type  COLUMN_NAME_T_SECUR  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

type  VALUE_EXPR£SSION_T_SECUR  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 

type  COLUMN_NAME_T_SHORT_NAME  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT / 

type  VALUE_EXPRESSION_T_SHORT_NAME  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 


type  COLUMN_NAME_T_TPSN  is  new 
ADA_SQL_FUNCT ION S . TYPED_SQL_OB JECT ; 

type  V ALUE_EXP  RE  SSI ON_T_T P  S N  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT; 

type  COLUMN_NAME_T_ULC  is  new 
ADA_SQL_FUNCT ION S . TYPED_SQL_OB JECT ; 

type  VALUE_EXPRES SI ON_T_ULC  is  new 
ADA_SQL_FUNCT ION S . TYPED_SQL_OBJECT ; 

type  COLUMN_NAME_T_UTC  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

type  VALUE_EXPRESSION_T_UTC  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

end  DATABASE_TYPES ; 
end  B I DE_P ACKAGE; 
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package  COMMAND_PACKAGE  is 

type  TABLE_NAME  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

type  SET_CLAUSE  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

package  DATABASE_TYPES  is 

type  COLUMN_NAME_T_DATE  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 

type  COLUMN_NAME_T_SECUR  is  new 
ADA_SQL_FUNCT IONS . TYPED_SQL_OB JECT ; 

type  COLUMN_NAME_T_UIC  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT; 

type  VALUE_EXPRESSION_T_UIC  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 

end  DATABASEJTYPES; 

package  STANDARD  is 

type  COLUMN_NAME_BOOLEAN  is  new 
ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 

end  STANDARD; 

end  COMMAND_PACKAGE ; 

end  DATABASE_DEFINITION_PACKAGE ; 

package  DATABASE_TYPES_TYPE_PACKAGE  is 

type  VALUE_EXPRESSION_T_UIC  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OBJECT ; 

end  DATABASE_TYPES_TYPE_PACKAGE ; 

end  ADA_SQL; 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  STANDARD . CHARACTER  )  return  STANDARD . CHARACTER ; 

function  L_CONVERT  (  L  :  STANDARD . BOOLEAN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT; 

function  R_CONVERT  (  R  :  STANDARD . BOOLEAN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_DATE  ) 
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return  ADA_SQL_FUNCTIONS . SQL_OBJECT ; 

function  RJZONVERT  (  R  :  DATABASEJTYPES . ADA_SQL . T_DATE  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  renames  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASEJTYPES . ADA_SQL . T_REVAL  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT ; 

function  R_CONVERT  (  R  :  DATABASEJTYPES . ADA_SQL . T_REVAL  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  renames  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASEJTYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT ; 

function  RECONVERT  (  R  :  DATABASE_TYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_SHORT_NAME  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT ; 

function  R_CONVERT  (  R  :  DATABASEJTYPES . ADA_SQL . T_SHORT_NAME  ) 
return  ADA_SQL_FUNCT IONS . SQL_OB JECT  renames  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASEJTYPES . ADA_SQL . TJIPSN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT ; 

function  R_CONVERT  (  R  :  DATABASEJTYPES . ADA_SQL . T_TPSN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_UIC  ) 
return  ADA_SQL_FUNCTIONS. SQL_OBJECT; 

function  R_CONVERT  (  R  :  DATABASE_TYPES . ADA_SQL . T_UIC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_ULC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT ; 

function  R_CONVERT  (  R  :  DATABASEJTYPES . ADA_SQL . T_ULC  ) 
return  ADA_SQL_FUNCTIONS . SQL__OBJECT  renames  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_UTC  ) 
return  ADA_SQL_FUNCT IONS , SQL_OBJECT; 

function  R_CONVERT  (  R  :  DATABASE_TYPES . ADA_SQL . T_UTC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

procedure  DELETE 

(  FROM  :  in  ADA_SQL_FUNCTIONS.TABLE_NAME,- 

WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  := 
ADA_SQL_FUNCT I ONS . NULL_SEARCH_CONDITION  ) 
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renames  ADA_SQL_FUNCTIONS . DELETE ; 
procedure  INSERT_INTO 

(  TABLE  :  in  ADA_SQL_FUNCTIONS . TABLE_NAME; 

VALUES  :  in  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  ) 
renames  ADA_SQL_FUNCTIONS . INSERT_INTO; 

procedure  SELEC 

(  WHAT  :  in  ADA_SQL_FUNCTIONS.SELECT_LIST; 

FROM  :  in  ADA_SQL_FUNCTIONS . FROM_CLAUSE; 

WHERE  :  in  ADA__SQL_FUNCTIONS .  SEARCH_CONDITION  :  = 
ADA_SQL_FUNCTIONS . NULL_SEARCH_CONDITION  ) ; 

procedure  UPDATE 

(  TABLE  :  in  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . 
TABLE_NAME ; 

SET  :  in  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
SET_CLAUSE; 

WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  := 
ADA_SQL_FUNCTIONS . NULL_SEARCH_CONDITION  ) ; 

procedure  UPDATE 

(  TABLE  :  in  ADA__SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . 
TABLE_NAME; 

SET  :  in  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
SET_CLAUSE ; 

WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  := 
ADA_SQL_FUNCTIONS . NULL_SEARCH_CONDITION  ) / 

function  BIDE  return  ADA_SQL_FUNCTIONS . FROM_CLAUSE; 

function  BIDE  return  ADA_SQL_FUNCTIONS .TABLE_NAME; 

function  BIDE 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_PACKAGE . TABLE_NAME ; 
function  COMMAND  return  ADA_SQL_FUNCTIONS . FROM_CLAUSE; 
function  COMMAND  return  ADA_SQL_FUNCTIONS . TABLE_NAME; 
function  COMMAND 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . TABLE_NAME; 

function  IS_MAJOR  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

function  IS_MAJOR 
return 

ADA_SQL . DATABA3E_DEFINITI0N_PACKAGE . COMMAND_PACKAGE . STANDARD . 
COLUMN_NAME_BOOLEAN ; 

function  MAJCOM  return  ADA_SQL_FUNCTIONS . VALUE_ EXPRESSION; 
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function  MAJCOM 
return 

ADA_SQL .  DATAB  ASE_DEF  I NI T I ON_P ACKAGE .  COMMAND_PACKAGE .  DATABASE_TYPES 
COLUMN_NAME_T_UIC ; 

function  ORG_SCLASS  return  ADA_SQL_FUNCTIONS . VALUE_EXP RES SION ; 

function  ORG_SCLASS 
return 

ADA_SQL .  DATABASE_DEFINITION_P ACKAGE  .  B I DE_P ACKAGE .  DATABASEJTYPES  . 
COLUMN_NAME _T_SECUR ; 

function  REC_SCLASS 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  BIDE_P ACKAGE .  DATABASE_TYPES  . 
COLUMN_NAME_T_SECUR ; 

function  REC_SCLASS 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  COMMAND_P ACKAGE  .  DATABASEJTYPES 
COLUMN_NAME_T_SECUR ; 

function  REPORT_DATE 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  BIDE_P ACKAGE .  DATABASEJIYPES  . 
COLUMN_NAME_T_DATE ; 

function  REPORT_DATE 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  COMMAND_P ACKAGE .  DATABASE_TYPES 
COLUMN_NAME_T_DATE ; 

function  REVAL  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

function  REVAL 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  B I DE_P ACKAGE  .  DATABASE_TYPES  . 
COLUMN_NAME_T_REVAL ; 

function  SHORT_NAME  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

function  SHORT_NAME 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE . B I DE_P ACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_SHORT_NAME ; 

function  TPSN  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION ; 

function  TPSN 
return 

ADA_SQL  .  DATABASE_DEFINITION_PACKAGE  .  BIDE_P ACKAGE  .  DATABASE_TYPES  . 
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COLUMN_NAME_T_TPSN ; 
function  UIC 

return  ADA_SQL . DATABASE  JTYPESJTYPE_PACKAGE . VALUE_EXPRESSION_T_UIC ; 
function  ULC  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 


function  ULC 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_XYPES . 

COLUMN_NAME  JT_ULC ; 

function  UPDATE_DATE 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASEJTYPES . 

COLUMN_NAME_T_DATE ; 

function  UPDATE_DATE 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . DATABASEJTYPES . 

COLUMN_NAMEJT_DATE ; 

function  UTC  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

function  UTC 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 

COLUMN_NAME  JT_UTC ; 

function  VALUES  return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST_STARTER 
renames  AD A_SQL_F UNCT I ON S . VALUES ; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_REVAL ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VAHTE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_REVAL ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACK AGE . BIDF_PACKAGE . DATABASEJTYPES . 

VALUE_EXPRESSION_T_REVAL; 


function  INDICATOR 

(  VALUE  :  DATABASEJTYPES. ADA_SQL.T_SECUR ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCT IONS . VALUE_SPECIFICATION; 
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function  INDICATOR 

{  VALUE  :  DATABASEJTYPES . ADA_SQL . T_SECUR; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
VALUE_EXPRESSION_T_SECUR ; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES . ADA_SQL . T_SHORT_NAME ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES. ADA_SQL.T_SHORT_NAME; 

IND  :  ADA_SQL_F UNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
VALUE_EXPRESSION_T_SHORT_NAME ; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES . ADAJSQL . TJTPSN; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCT ION S . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . 1  TPSN; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 

AD A_SQL_FUNCT I ON S . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B IDE_PACKAGE . DATABASE_TYPES . 
VALUE_EXPRESSIONJTJTPSN; 

function  INDICATOR 

(  VALUE  :  DATABASE JIYPES.ADA_SQL. T_UIC; 

IND  :  ADA__SQL_FUNCT ION S  .  INDICATOR  J/ARIABLE  :  = 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 
return  ADA_SQL_F UNCTION S . VALUE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASE  JTYPES.ADA_SQL.T_UIC; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  : = 
ADA_SQL_FUNCT IONS . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 
VALUE_EXPRESSION_T_UIC ; 

function  INDICATOR 
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(  VALUE  :  DATABASE  JTYPES.ADA_SQL.T_ULC; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  :» 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASE  JTYPES.ADA_SQL.T_ULC; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 

return 

ADA_SQL . DATAB ASE_DEF INIT ION_P ACKAGE . BID E_P AC K  AGE . DATABASEJTYPES 
VALUE_EXPRESSION  T_ULC; 


function  INDICATOR 

(  VALUE  :  DATABASEJTYPES. ADA_SQL.T_UTC; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  : = 
ADA_SQL_FUNCTIONS .  NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES . ADA_SQL . TJUTC ; 

IND  :  ADA_SQL_FUNCTIONS. INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASEJTYPES 
VALUE_EXPRESSION_T_UTC / 

procedure  INTO 

(  TARGET  :  out  STANDARD . BOOLEAN ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  ) ; 

procedure  INTO 

(  TARGET  :  out  DATABASE_TYPES . ADA_SQL . T_REVAL; 

LAST  :  out  DATABASEJTYPES. ADA_SQL.X_REVAL ; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_F UNCT IONS . NULL_CURSOR_NAME  ) ; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL. T_SECUR; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR  J/ARIABLE ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_FUNCTIONS.NULL_CURSOR_NAME  ) ; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL . T_SHORT_NAME ; 

LAST  :  out  DATABASEJTYPES . ADA_SQL . X_SHORT_NAME; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR J/ARIABLE ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_FUNCT IONS . NULL_CURSOR_NAME  ) ; 
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procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES. ADA_SQL.TJTPSN; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME 

ADA_SQL_FUNCT ION S . NULL_CURSOR_NAME  ) ; 

procedure  INTO 

(  TARGET  :  out  DATABASE  JTYPES . ADA_SQL . T_UIC ; 

LAST  :  out  DATABASEJTYPES.ADA_SQL.X_UIC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  ) / 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL . T_ULC ; 

LAST  :  out  DATABASEJTYPES.ADA_SQL.X_ULC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  : » 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  ) ; 

procedure  INTO 

(  TARGET  :  out  DATABASE  JTYPES. ADA_SQL.T_UTC; 

LAST  :  out  DATABASE  JTYPES. ADA_SQL.X_UTC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE ; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  ) ; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS. INSERT_VALUE_LIST; 

R  :  ADA_SQL_FUNCTIONS.VALUE_SPECIFICATION  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS.INSERT_VALUE_LIST; 

R  :  DATABASEJTYPES . ADA_SQL , T_DATE  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS. INSERT  J/ALUE_LIST; 

R  :  DATABASE_TYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS .  INSERT_VALUE__LIST; 

R  :  STANDARD . BOOLEAN  ) 
return  ADA_SQL_FUNCTIONS . INSERT J/ALUE_LI ST ; 

function  "and" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. SET_CLAUSE; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE.SET_CLAUSE  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE . SET_CLAUSE; 


56 

UNCLASSIFIED 


UNCLASSIFIED 


function  "and" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACRAGE . 
SET_CLAUSE ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACRAGE. 
SET_CLAUSE  ) 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE ; 
function  EQ 

(  L  :  ADA_SQL . DATABASE_TYPES_TYPE_PACKAGE . VALUE_EXPRESSION_T_UIC ; 

R  :  DATABASE_TYPES . ADA_SQL . T_UIC  ) 
return  ADA_SQL_FUNCTIONS . S EARCH_C OND I T I ON ; 

function  "6” 

(  L  :  ADA_SQL_FUNCTIONS . SELECT_LIST; 

R  :  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  ) 
return  ADA_SQL_FUNCTIONS . SELECT_LIST; 

function 

(  L  :  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

R  :  ADA_SQL_FUNCTIONS.VALUE_EXPRESSION  ) 
return  ADA_SQL_FUNCTIONS . SELECT_LIST; 

function  "<■" 

(  L  :  ADA_SQL_FUNCTIONS.INSERT_VALUE_LIST_STARTER; 

R  :  DATABASE_TYPES.ADA_SQL.T_UIC  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 

function  "<*" 

(  L  :  ADA_SQL. DATABASE_DEFINITION_PACKAGE.COMMAND_PACRAGE. STANDARD. 
COLUMN_NAME_BOOLEAN ; 

R  t  STANDARD . BOOLEAN  ) 

return  ADA_SQL . DATABASE_DEFINITION_PALKAGE . COMMAND_PACKAGE . SET_CLAUSE ; 
function  "<=" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . 
DATABASEJIYPES . COLUMN_NAME_T_DATE ; 

R  :  DATABASE_TYPES . ADA_SQL . T_DATE  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . SET_CLAUSE; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_DATE ; 

R  :  DATABASE_TYPES.ADA_SQL.T_DATE  ) 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE; 
function  "<=" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_REVAL ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . VALUE_EXPRESSION_T_REVAL  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_PACKAGE . SET_CLAUSE; 
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function  "<■*" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_SECUR ; 

R  :  DATABASE_TYPES  .  ADA_SQL .  T_SECUR  ) 
return  ADA_SQL .  DATABASE_DEFINITION_PACKAGE .  BIDE_PACKAGE .  SET_CLAUSE ; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES .  COLUMN_NAME_T_SECUR  ,• 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 

DAT ABASE_TYPE S .  VALUE_EXPRESSION_T_SECUR  ) 
return  ADA_SQL .  DATABASE_DEFINITION_PACKAGE  .  BIDE_PACKAGE .  SET_CLAUSE ; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMANDJ?ACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_SECUR ; 

R  :  DATABASE_TYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL .  DATABASE_DEFINITION_PACKAGE .  COMMAND_PACKAGE .  SET_CLAUSE ; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_SHORT_NAME ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . V ALUE_EXP RE S S I ON_T_SHORT_NAME  ) 
return  ADA__SQL .  DATABASE_DEFINITION_PACKAGE .  BIDE_PACKAGE .  SET_CLAUSE  ; 

function 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_TPSN ; 

R  :  ADA_SQL.DATABASE_DEFINITION__PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES  V ALUE_EXPRE SSI ON_T_TP SN  ) 
return  ADA_SQL .  DATABASE_DEFINITION_PACKAGE .  BIDE_PACKAGE .  SET_CLAUSE  ; 

function  "<=•" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_UIC ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASE_TYPES . VALUE_EXPRESSION_T_UIC  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE ; 

function  "<=* 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASEJIYPES . COLUMN_NAME_T_ULC ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . VALUE_EXPRESSION_T_ULC  ) 
return  ADA_SQL. DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE . SET_CLAUSE; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_UTC ; 

R  :  ADA  SQL . DATABASE_DEFINITION  PACKAGE . BIDE_PACKAGE , 


58 

UNCLASSIFIED 


UNCLASSIFIED 


DATABASEJTYPES . VALUE_EXPRESSION_T_UTC  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . SET_CLAUSE 

end  DAT ABASE_CARD_A_ADA_SQL ; 

with  DATABASE; 

package  body  DAT AB A S E_C ARD_A_AD A_S QL  is 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  STANDARD. CHARACTER  )  return  STANDARD . CHARACTER  is 

begin 

return  C; 

end  CONVERT_COMPONENT_TO_CHARACTER; 

function  L_CONVERT  (  L  :  STANDARD . BOOLEAN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  is 
begin 
return 

ADA_SQL_F  UNCTIONS . INTEGER_AND_ENUMERAT I ON_CONVERT 
(  DATABASE. INT  (  STANDARD . BOOLEAN ' POS  (  L  )  )  ); 
end  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASEJTYPES . ADA_SQL . T_DATE  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  is 
begin 
return 

ADA_SQL_FUNCT I ON S . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  STANDARD . STRING  (  L  )  ); 
end  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_REVAL  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  STANDARD . STRING  (  L  )  )  ; 
end  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 
return 

ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERATION_CONVERT 
(  DATABASE. INT  (  DATABASEJTYPES . ADA_SQL . T_SECUR' POS  (  L  )  )  ); 
end  L_CONVERT ; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_SHORT_NAME  ) 
return  ADA_SQL_FUNCT IONS . SQL_OB JECT  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONSTRAINED  CHARACTER  STRING  CONVERT 
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(  STANDARD . STRING  (  L  )  ); 
end  L_CONVERT / 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_TPSN  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 
return 

ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERATION_CONVERT 
(  DATABASE. INT  (  DATABASE_TYPES . ADA_SQL. TJTPSN' POS  (  L  )  )  ); 
end  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_UIC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  is 
begin 
return 

AD A_SQL_FUNCT I ON S . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  STANDARD . STRING  (  L  )  ) ; 
end  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL. T_ULC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 
return 

ADA_SQL_FUNCT I ON S . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  STANDARD . STRING  (  L  )  ) ; 
end  L_CONVERT; 

function  L_CONVERT  (  L  :  DATABASE_TYPES . ADA_SQL . T_UTC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  STANDARD . STRING  (  L  )  ) ; 
end  L_CONVERT; 

procedure  SELEC 

(  WHAT  :  in  ADA_SQL_FUNCTIONS . SELECT_LIST; 

FROM  :  in  ADA_SQL_FUNCTIONS . FROM_CLAUSE; 

WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  : = 
ADA_SQL_FUNCTIONS.NULL_SEARCH_CONDITION  )  is 

begin 

ADA_SQL_FUNCTIONS . SELECT_LIST_SELECT 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

ADA_SQL_FUNCTIONS . CONVERT . L_CONVERT  (  WHAT  )  ,  FROM  ,  WHERE  ) ; 
end  SELEC; 

procedure  UPDATE 

(  TABLE  :  in  ADA_SQL. DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE. 
TABLE_NAME; 

SET  :  in  ADA_SQL. DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE. 
SET  CLAUSE; 
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WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION 
ADA_SQL_FUNCTIONS.NULL_SEARCH_CONDITION  )  is 

begin 

ADA_SQL_FUNCTIONS . UPDATE_PROCEDURE 

(  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE.L_CONVERT  (  TABLE  ), 
ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE.L_CONVERT  (  SET  ), 
WHERE  ) ; 
end  UPDATE; 

procedure  UPDATE 

(  TABLE  :  in  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . 
TABLE_NAME; 

SET  :  in  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . 
SET_CLAUSE; 

WHERE  :  in  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  := 
ADA_SQL_FUNCTIONS . NULL_SEARCH_CONDITION  )  is 

begin 

ADA_SQL_FUNCTIONS . UPDATE_PROCEDURE 

(  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE.L_CONVERT  (  TABLE  ), 
ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . L_CONVERT  (  SET  )  , 
WHERE  ) ; 
end  UPDATE; 

function  BIDE  return  ADA_SQL_FUNCTIONS . FROM_CLAUSE  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "BIDE"  )  ); 
end  BIDE; 

function  BIDE  return  ADA_SQL_FUNCTIONS . TABLE_NAME  is 
begin 
return 

ADA_SQL_FUNCT ION S . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "BIDE"  )  ); 
end  BIDE; 

function  BIDE 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . TABLE_NAME  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "BIDE"  )  ); 
end  BIDE; 


function  COMMAND  return  ADA_SQL_FUNCTIONS . FROM_CLAUSE  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "COMMAND"  )  ); 
end  COMMAND; 
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function  COMMAND  return  ADA_SQL_FUNCTIONS . TABLE_NAME  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "COMMAND"  )  ) / 
end  COMMAND; 

function  COMMAND 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . TABLE_NAME  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "COMMAND"  )  ); 
end  COMMAND; 

function  IS_MAJOR  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "IS_MAJOR"  )  ); 
end  IS_MAJOR; 

function  IS_MAJOR 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . STANDARD . 
COLUMN_NAME_BOOLEAN  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . STANDARD . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "IS_MAJOR"  )  ); 
end  IS_MAJOR; 

function  MAJCOM  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

AD A_SQL_FUNCT I ON S . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "MAJCOM"  )  )  ; 
end  MAJCOM; 

function  MAJCOM 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_UIC  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 
CONVERT_R  (  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "MAJCOM"  )  ) ; 

end  MAJCOM; 

function  ORG_SCLASS  return  ADA_SOL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
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return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "ORG_SCLASS"  )  ); 
end  ORG_SCLASS; 

function  ORG_SCLASS 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_P ACKAGE . DATABASE_TYPES . 
COLUMN_NAMEJT_SECUR  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . B I DE_P ACKAGE . DATABASEJTYPES . CONVERT_R 
(  ADAJ3QL_FUNCTI0NS.C0LUMN_0RJIABLE_NAME  (  "ORG_SCLASS"  )  ); 
end  ORG_SCLASS ; 

function  REC_SCLASS 
return 

ADA_SOL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASEJTYPES . 

COLUMN  JstAMEJT_SECUR  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "REC_SCLASS"  )  ); 
end  REC_SCLASS; 

function  REC_SCLASS 
return 

ADA_SQL .  DATABASE_DEFINITION_P ACKAGE .  COMMAND_P ACKAGE .  DATABASEJTYPES  . 

COLUMN  JJAMEJIJSECUR  is 
begin 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE  .  COMMAND_P ACKAGE .  DATABASE_TYPES  . 
CONVERT_R  (  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "REC_SCLASS"  )  ) ; 
end  REC_SCLASS; 

function  REPORT_DATE 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . 
COLUMN_NAMEJT_DATE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  " REPORT J> ATE"  )  )/ 
end  REPORT_DATE ; 

function  REPORT_DATE 
return 

ADA_SQL . DATABASE  J)EFINITION_PACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_DATE  is 
begin 
return 
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ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 
CONVERT_R  (  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  " REPORT_DATE "  )  ); 
end  REPORT_DATE; 

function  REVAL  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

ADA_SQL_FUNCT ION S . CONVERT . CONVERTER 

(  ADA_SQL_FUNCTIONS. COLUMN _OR_TABLE_NAME  (  "REVAL"  )  ); 
end  REVAL; 

function  REVAL 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B IDE_PACKAGE . DATABASE_TYPES  . 
COLUMN_NAME_T_REVAL  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "REVAL"  )  ); 
end  REVAL; 

function  SHORT_NAME  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERTJR 

(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "SHORT_NAME"  )  ); 

end  SHORT_NAME ; 

function  SHORT_NAME 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES  . 
COLUMN_NAME_T_SHORT_NAME  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  " SHORT_NAME "  )  ); 

end  SHORT_NAME; 

function  TPSN  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "TPSN"  )  ); 

end  TPSN; 

function  TPSN 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_TPSN  is 
begin 
return 
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ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "TPSN"  )  ); 
end  TPSN; 

function  UIC 

return  ADA_SQL.DATABASE_TYPES_TYPE_PACKAGE.VALUE_EXPRESSION_T_UIC  is 
begin 
return 

ADA_SQL . DATABASE_TYPES_TYPE_P ACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "UIC"  )  ); 
end  UIC; 

function  ULC  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "ULC"  )  ); 
end  ULC; 

function  ULC 
return 

ADA_SQL . DATAB ASE_DEF INIT I ON_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_ULC  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "ULC"  )  ); 
end  ULC; 

function  UPDATE_DATE 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE. DATABASE_TYPES . 
COLUMN_NAME_T_DATE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  " UPDATE_DATE "  )  ); 
end  UPDATE_DATE; 

function  UPDATE_DATE 
return 

ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE .  COMMAND_PACKAGE  .  DATAB ASE_TYPES  . 
COLUMN_NAME_T_DATE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . COMMAND_P ACKAGE . DATAB ASE_TYPES . 
CONVERT_R  (  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  " UPDATE_DATE "  )  ); 
end  UPDATE_DATE ; 

function  UTC  return  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  is 
begin 
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return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 

(  ADA_SQL_FUNCTIONS.COLUMN_OR_TABLE_NAME  (  "UTC"  )  ); 
end  UTC; 

function  UTC 
return 

ADA_SQL . DAT ABA SE_DEF INI T I ON_P ACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
COLUMN_NAME_T_UTC  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES 
(  ADA_SQL_FUNCTIONS . COLUMN_OR_TABLE_NAME  (  "UTC"  )  ); 
end  UTC; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_REVAL; 

IND  :  ADA_SQL_FUNCTIONS.INDICATOR_VARIABLE  := 

AD A_S QL_F UNCT IONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
{  L_CONVERT  (  VALUE  )  ,  IND  )  ); 
end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES.ADA_SQL.T_REVAL; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCT ION S . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES  . 

V ALUE_EXP RE S S I ON_T _REV AL  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE  TYPES . 
(  ADA_SQL_F UNCT IONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ) ; 
end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_SECUR; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  : = 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTTONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ) ; 


CONVERT  R 


CONVERT  R 


66 

UNCLASSIFIED 


UNCLASSIFIED 


end  INDICATOR; 
function  INDICATOR 

(  VALUE  :  DATABASE_TYPES.ADA_SQL.T_SECUR; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  :« 

ADA_SQL_FUNCTIONS . NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE , BIDE_PACKAGE . DATABASE_TYPES . 

VALUE_EXP RE S S I ON_T_S EC UR  is 

begin  " 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ); 
end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES.ADA_SQL.T_SHORT_NAME; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 

ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS. INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES.ADA_SQL.T_SHORT_NAME; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  : = 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 

VALUE_EXP RES S I ON__T_SHOP  T_NAME  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B IDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_F UNCTIONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_TPSN ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 

ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
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(  v  CONVERT  (  VALUE  )  ,  IND  )  ) ; 
end  INL - „ATOR ; 

function  INDICATOR 

(  VALUE  :  DATABASEJIYPES.ADA_SQL.TJTPSN; 

IND  :  ADA_SQL_FUNCTIONS . IND ICATOR_VARI ABLE 
ADA_SQL_FUNCT IONS. NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES  . 
VALUE_EXPRESSION_T_TPSN  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS. INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ) ; 
end  INDICATOR; 


function  INDICATOR 

(  VALUE  :  DATABASEJTYPES . ADA_SQL . T_UIC ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ) ; 

end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES. ADA_SQL.T_UIC; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  : = 
ADA_SQL_FUNCTIl''tS  .  NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . COMMAND_P ACKAGE . DATABASEJTYPES . 
VALUE_EXPRESSION_T_UIC  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . COMMAND_P ACKAGE . DATABASE_TYPES . 
CONVERTJR 

(  ADA_SQL_FUNCTIONS. INDICATOR_FUNCTION  (  L_CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR; 

function  INDICATOR 

(  VALUE  :  DATABASEJTYPES . ADA_SQL . T_ULC ; 

IND  :  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE  := 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
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(  ADA_SQL_FUNCTIONS. INDICATOR_FUNCTION 
(  L_CONVERT  {  VALUE  )  ,  IND  )  ) ; 
end  INDICATOR; 

function  INDICATOR 

{  VALUE  :  DATABASE_TYPES . ADA_SQL . T_ULC ; 

IND  :  ADA_SQL_FUNCTIONS . I ND I C ATOR_VAR I AB LE  : - 
ADA_SQL_FUNCTIONS.NOT_NULL  ) 

return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . B I DE_P ACKAGE . DATABASEJTYPES . 
VALUE_EXPRESSION_T_ULC  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . B IDE_P ACKAGE . DATABASE_TYPES . CONVERT_R 
(  ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR ; 

function  INDICATOR 

(  VALUE  :  DATABASE_TYPES . ADA_SQL . T_UTC ; 

IND  :  ADA_SQL_FUNCTIONS. INDICATOR_VARIABLE 
ADA_SQL_FUNCTIONS . NOT_NULL  ) 
return  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  is 
begin 
return 

ADA  SQL_FUNCTIONS  .  CONVERT  .  CONVERT_R 
(  AD A_50L_F UNCTIONS . INDICATOR_FUNCTION 
(  L_CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR; 

function  INDICATOR 

(  VALl  :  DATABASE_TYPES.ADA_SQL.T_UTC; 

IND  :  ADA_SQL_FUNCTIONS. INDICATOR_VARIABLE 

ADA_SQL_FUNCTIONS . NOT_NUIL  ) 

return 

ADA  SQL .  DATABASE  DEFINITION  PACKAGE  .  B I DE_? ACKAGE  .  DATABASF.  TYPES  . 

VALUE  EXPRESSION  T  UTC  is 
beg  i  n 
return 

ADA  SQL . DATABASE  DEF IN IT IONPACKAGE . BIDEPACKAGE . D AT AB/^SE  TYPES . CONVERT  R 
(  ADA  SQL  FUNCTIONS. INDICATOR_FUNCTION 
(  r,  CONVERT  (  VALUE  )  ,  IND  )  ); 

end  INDICATOR; 

pro<-;erlu  re  INTO 

(  TARGET  :  out  STANDARD. BOOLEAN; 

CURSOR  :  in  ADASQL  FUNCTIONS. CURSOR  NAME 
ADA  SQI.  FUNCTIONS .  NULL  CURSOR  NAME  )  is 
OUR  TARGET  :  DATABASE . INT ; 
b«><(  |  n 

ADA  SQL  FUNCTIONS . INTEGER  AND  ENUMERATION  INTO 


m 
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(  OURJTARGET  ,  CURSOR  ); 

TARGET  STANDARD . BOOLEAN ' VAL  (  OUR_TARGET  ); 

end  INTO; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL . T_REVAL ; 

LAST  :  out  DATABASEJTYPES . ADA_SQL . X_REVAL; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS.CURSOR_NAME 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  )  is 

begin 

ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 

(  STANDARD . STRING  (  TARGET  )  ,  STANDARD . NATURAL  (  LAST  )  ,  INDICATOR 
CURSOR  ) ; 
end  INTO; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL . T_SECUR; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATORJVARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 

ADA_SQLJFUNCTIONS.NULL_CURSOR_NAME  )  is 
OUR_TARGET  :  DATABASE . INT ; 
begin 

ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERAT I ON_INTO 
(  OURJTARGET  ,  INDICATOR  ,  CURSOR  ); 

TARGET  :=  DATABASEJTYPES . ADA_SQL . T_SECUR' VAL  (  OURJTARGET  ); 
end  INTO; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADAJSQL . T_SHORT_NAME ; 

LAST  :  out  DATABASEJTYPES . ADA_SQL . X_SHORT_NAME  ; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 
CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 
ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  )  is 

begin 

ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 

(  STANDARD . STRING  (  TARGET  )  ,  STANDARD . NATURAL  (  LAST  )  ,  INDICATOR 
CURSOR  ) ; 
end  INTO; 

procedure  INTO 

(  TARGET  :  out  DATABASEJTYPES . ADA_SQL. TJTPSN; 

INDICATOR  :  out  ADA_SQL_FUNCT IONS . INDICATOR_VARI ABLE ; 
CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  := 
ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  )  is 
OURJTARGET  :  DATABASE . INT ; 
begin 

ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERATION_INTO 
(  OUR_TARGET  ,  INDICATOR  ,  CURSOR  ) ; 

TARGET  :=  DATABASE_TYPES . ADA_SQL . T_TPSN' VAL  (  OUR_TARGET  ) ; 
end  INTO; 
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procedure  INTO 

(  TARGET  :  out  DATABASE_TYPES . ADA_SQL . T_UIC ; 

LAST  :  out  DATABASE_TYPES.ADA_SQL.X_UIC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  :« 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  )  is 

begin 

ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 

(  STANDARD . STRING  (  TARGET  )  ,  STANDARD . NATURAL  {  LAST  )  ,  INDICATOR 
CURSOR  ) ; 
end  INTO; 

procedure  INTO 

(  TARGET  :  out  DAT’.BASE_TYPES  .  ADA_SQL .  T_ULC; 

LAST  :  out  DATABASE_TYPES.ADA_SQL.X_ULC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS . CURSOR_NAME  :» 

ADA_SQL_FUNCTIONS.NULL_CURSOR_NAME  )  is 

begin 

ADA_SQL_FUNCTIONS . CO NSTRAINED_STRING_INTO 

(  STANDARD . STRING  (  TARGET  )  ,  STANDARD . NATURAL  (  LAST  )  ,  INDICATOR 
CURSOR  ) ; 
end  INTO; 

procedure  INTO 

(  TARGET  :  out  DATABASE_TYPES . ADA_SQL . T_UTC ; 

LAST  :  out  DATABASE_TYPES. ADA_SQL.X_UTC; 

INDICATOR  :  out  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 

CURSOR  :  in  ADA_SQL_FUNCTIONS.CURSOR_NAME  :« 

ADA_SQL_FUNCTIONS . NULL_CURSOR_NAME  )  is 

begin 

ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 

(  STANDARD . STRING  (  TARGET  )  ,  STANDARD . NATURAL  (  LAST  )  ,  INDICATOR 
CURSOR  ) ; 
end  INTO; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 

R  :  ADA_SQL_FUNCTIONS . VALUE_SPECIFICATION  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AND , 

ADA_SQL_FUNCTIONS . CONVERT . L_CONVERT  (  L  ) , 

ADA_SQL_FUNCTIONS . CONVERT . R_CONVERT  (  R  )  )  ); 
end  "and"; 

function  "and" 

(  L  :  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST; 
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R  :  DATABASEJIYPES . ADA_SQL . T_DATE  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AND , 

ADA_SQL_FUNCTIONS . CONVERT . L_CONVERT  (  L  ) , 
RECONVERT  (  R  )  )  ); 
end  "and*; 


function  "and" 

(  L  :  ADA_SQL_FUNCTIONS. INSERT_VALUE_LIST; 
R  :  DATABASE_TYPES . ADA_SQL , T_SECUR  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CO NVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AND, 

ADA_SQL_FUNCTIONS . CONVERT . L_CONVERT  (  L  ) , 
RECONVERT  (  R  )  )  )  ; 

end  "and"; 


function  "and" 

(  L  :  AUA_SQL_FUNCTIONS . INSERT_VALUE_LIST ; 
R  :  STANDARD . BOOLEAN  ) 

return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_AND , 

ADA_SQL_FUNCTIONS. CONVERT. L_CONVERT  (  L  ), 
RECONVERT  (  R  )  )  ) ; 
end  "and"; 


function  "and" 

(  L  :  ADA_SQL. DATABASE_DEFINITION_PACKAGE. BIDE_PACKAGE. SET_CLAUSE; 
R  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . SET_CLAUSE 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AND , 

ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE,L_CONVERT  (  L  ) , 
ADA_SQL,DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE.R_CONVERT  (  R  )  )  ) 

end  "and"; 


function  "and" 
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(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
SET_CLAUSE; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
SET_CLAUSE  ) 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL. DATABASE_DEFINITION_PACKAGE. COMMAND_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AND, 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . L_CONVERT  (  L  ), 
ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . R_CONVERT 
(  R  )  )  ); 
end  "and"; 

function  EQ 

(  L  :  ADA_SQL.DATABASE_TYPES_TYPE_PACKAGE. VALUE_EXPRESSION_T_UIC; 

R  :  DATABASE_TYPES.ADA_SQL.T_UIC  ) 
return  ADA_SQL_FUNCTIONS . SEARCH_CONDITION  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_EQ , 

ADA_SQL.DATABASE_TYPES_TYPE_PACKAGE.L_CONVERT  (  L  ), 

R_CONVERT  (  R  )  )  )  ; 

end  EQ; 


function 

(  L  :  ADA_SQL_FUNCTIONS.SELECT_LIST; 

R  :  ADA_SQL_FUNCTIONS.VALUE_EXPRESSION  ) 
return  AD A_S QL_FUNCT IONS . SELECT_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AMPERSAND , 

ADA_SQL_FUNCTIONS. CONVERT. L_CONVERT  (  L  ) , 
ADA_SQL_FUNCTIONS. CONVERT. R_CONVERT  (  R  )  )  ); 

end 

function 

(  L  :  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION; 

R  :  ADA_SQL_FUNCTIONS . VALUE_EXPRESSION  ) 
return  ADA_SQL_FUNCTIONS . SELECT_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AMPERSAND, 

ADA_SQL_FUNCTIONS . CONVERT . L_CONVERT  (  L  ) , 
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ADA_SQL_FUNCTIONS . CONVERT . R_CONVERT  (  R  )  )  ); 
end  *  s " ; 

function  "<=" 

(  L  :  ADA_SQL_FUNCTIONS. INSERT_VALUE_LIST_STARTER; 
R  :  DATABASEJTYPES . ADA_SQL . T_UIC  ) 
return  ADA_SQL_FUNCTIONS . INSERT_VALUE_LIST  is 
begin 
return 

ADA_SQL_FUNCTIONS . CONVERT . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL_FUNCT I ONS . CONVERT . L_CONVERT  (  L  ) , 

R_CONVERT  (  R  )  )  ) ; 

end 


function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. STANDARD. 
COLUMN_NAME_BOOLEAN ; 

R  :  STANDARD . BOOLEAN  ) 

return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . CONVERTER 
(  AD A_SQL_FUNCT ION S . B INARY_OP ERAT I ON 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . STANDARD . 

L_CONVERT  (  L  ) , 

R_CONVERT  (  R  )  )  ) / 

end 


function  "<=" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_DATE ; 

R  :  DATABASE_TYPES . ADA_SQL . T_DATE  ) 
return  ADA_SQL . DATABASE_DEF INIT ION_PACKAGE . B I DE_P ACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . DATABASE_DEF INIT ION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES . 

L_CONVERT  (  L  ) , 

R_CONVERT  (  R  )  )  ) ; 

end 


function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASEJTYPES . COLUMN_NAME_T_DATE ; 

R  :  DATABASE_TYPES.ADA_SQL.T_DATE  ) 

return  ADA_SQL . DATABASE  DEFINITION  PACKAGE . COMMAND  PACKAGE. SET  CLAUSE  is 
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begin 

return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . COMMAND_PACKAGE . DATABASE_TYPES . 

L_CONVERT  (  L  ), 

R_CONVERT  (  R  )  )  ); 
end  "<«*"; 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_P ACKAGE. BIDE_P ACKAGE. 

DATAB ASE_T YP  E  S . COLUMN_NAME_T_REVAL ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_P ACKAGE. 
DATABASE_TYPES . VALUE_EXPRESSION_T_REVAL  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . B IDE_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  AD A_SQL_FUNCT ION S . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . DATABASEJIYPES . 
L_CONVERT  (  L  ) , 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
R_CONVERT  (  R  )  )  ); 

end 

function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_SECUR; 

R  :  DATABASEJTYPES . ADA_SQL . T_SECUR  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_P ACKAGE . DATABASE_TYPES . 

L_CONVERT  (  L  ) , 

R_CONVERT  (  R  )  )  )  ; 

end 


function  "<=" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_P ACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_SECUR; 

R  :  ADA_SQL . DATAB ASE_DEFINITION_PACKAGE . BIDE_P ACKAGE . 
DATABASE_TYPES . VALUE_EXPRESSION_T_SECUR  ) 
return  ADA_SQL . DAT ABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL. DATABASE  DEFINITION  PACKAGE. BIDE  PACKAGE . CONVERT  R 
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(  ADA_SQL_FUNCTIONS.BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL .  DAT  AB  ASE_DE  F I  NIT  I  ON_P  AC  K  AGE  .  B I  DE_P  ACKAGE  .  DATABASEJTYPES  . 
L_CONVERT  {  L  )  , 

ADA_SQL .  DATABASE  J3EF.  4ITI0N_PACKAGE .  B I DE_P ACKAGE  DATABASEJTYPES  . 
R_CONVERT  (  R  )  )  ) ; 

end 


function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASEJTYPES . COLUMN_NAMEJT_SECUR; 

R  :  DATABASEJTYPES . ADA_SQL . T_SECUR  ) 

return  ADA_SQL  .  DATABASE_DEFINITION_P ACKAGE .  COMMAND_P ACKAGE  .  SET_CLAUSE  is 
begin 
return 

ADA_SQL .  DATABASE_DEFINITION_PACKAGE .  COMMAND  J?ACKAGE  .  CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT ION S . 0_LE , 

ADA_SQL .  DATABASE_DEFINITION_P ACKAGE .  COMMAND_P ACKAGE  .  DATABASE_TYPES  . 

L_CONVERT  (  L  ) , 

R_CONVERT  (  R  )  )  ) ; 

end 

function  "<=" 

{  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASEJTYPES . COLUMN JMAMEJI_SHORT_NAME ; 

R  :  ADA_SQL.DATABASE_DEFINITION_P ACKAGE. BIDE_P ACKAGE. 
DATABASE_TYPES . VALUE_EXPRESSIONJT_SHORT_NAME  ) 
return  ADA_SQL.  DATABASE_DEFINITION_P ACKAGE.  BIDE_P ACKAGE.  SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL .  DATABASE_DEFINITION_PACKAGE  .  BIDE_PACKAGE  .  DATABASE_TYPES  . 
L_CONVERT  (  L  ) , 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASEJTYPES . 
R_CONVERT  (  R  )  )  )  ; 

end 

function  "<=" 

(  L  ;  ADA_SQL. DATABASE  J)EFINITION_PACKAGE . BIDE_PACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_TPSN ; 

R  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE , BIDE_P ACKAGE . 
DATABASE_TYPES . VALUE_EXPRESSION_T_TPSN  ) 
return  ADA_SQL. DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . B INARY_OPERAT I ON 
(  ADA_SQL_FUNCTIONS . 0_LE , 
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ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
L_CONVERT  (  L  ) , 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
R_CONVERT  (  R  )  )  ); 

end 


function  "<=" 

(  L  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASE_TYPES . COLUMN_NAME_T_UIC ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.COMMAND_PACKAGE. 
DATABASEJTYPES . VALUE_EXPRESSION_T_UIC  ) 
return  ADA_SQL . r  ATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SCL . DATABASE_DEFINITION_PACKAGE . COMMAND_PACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . COMMAND_P ACKAGE . DATABASE_TYPES 
L_CONVERT  (  L  ) , 

ADA_SQL . DATABASE_DEF INIT ION_PACKAGE . C OMMAND_P ACKAGE . DATABASEJTYPES 
R_CONVERT  {  R  )  )  ) ; 

end 

function  "<=" 

<  L  :  ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_PACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_ULC ; 

R  :  ADA_SQL.DATABASE_DEFINITION_PACKAGE.BIDE_PACKAGE. 
DATABASEJTYPES . VALUE_EXPRESSION_T_ULC  ) 
return  ADA_SQL . DATABASE_DEFINITION_PACKAGE . B I DE_P ACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . CONVERTJR 
(  ADA_SQL_FUNCT ION S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
L_CONVERT  (  L  ) , 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . DATABASE_TYPES . 
R_CONVERT  (  R  )  )  ) ; 

end 


function  "<=" 

(  L  :  ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_PACKAGE . 
DATABASE_TYPES . COLUMN_NAME_T_UTC ; 

R  :  ADA_SQL. DATABASE_DEFINITION_P ACKAGE. BIDE_PACKAGE. 
DATABASEJTYPES . VALUE_EXPRESSION_T_UTC  ) 
return  ADA_SQL . DAT ABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . SET_CLAUSE  is 
begin 
return 

ADA_SQL . DATABASE_DEFINITION_PACKAGE . BIDE_P ACKAGE . CONVERT_R 
(  ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_LE, 


77 

UNCLASSIFIED 


UNCLASSIFIED 


ADA_SQL , DATAB ASE_DEF INIT ION_P ACKAGE . BIDE_PACKAGE . DATAB ASE_TYPE S 
L_CONVERT  (  L  )  ,- 

ADA_SQL . DATABASE_DEFINITION_P ACKAGE . BIDE_P ACKAGE . DATABASE_TYPES 
R_CONVERT  (  R  )  )  ) ; 

end 

end  DATABASE  CARD  A  ADA  SQL; 
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7.7  DBVARS.ADA 


—  File:  dbvars . ada 

—  DATABASE_VARIABLES_ADA_SQL 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J.  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  ADA_SQL_FUNCTIONS ; 

package  DATABASE_VARIABLES_ADA_SQL  is 

subtype  INDICATOR_VARIABLE  is  ADA_SQL_FUNCTIONS . INDICATOR_VARIABLE; 
function  NULL_VALUE  return  INDICATOR_VARIABLE 
renames  ADA_SQL_FUNCTIONS . NULL_VALUE; 
function  NOT_NULL  return  INDICATOR_VARIABLE 
renames  ADA_SQL_FUNCTIONS . NOT_NULL; 
end  DATABASE_VARIABLES_ADA  SQL; 
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7.8 


DBVARS.ADS 


—  File:  dbvars . ads 

—  DATABASE_VARIABLES 

—  12/18/88 


—  Fred  J.  Friedman 

—  RACOM  Computer  Professionals 

—  P.0.  Box  576 

—  Annandale,  VA  22003-1620 

—  (703)  560-6813  (703)  560-6799 

With  DATABASEJTYPES ,  DATABASE_VARIABLES_ADA_SQL; 

use  DATABASE_VARIABLES_ADA_SQL ; 
package  DATABASE_VARIABLES  is 


use  DATABASEJTYPES. ADA_SQL; 


V  IS  MAJOR 


BOOLEAN; 


I_MAJCOM 
V_MAJCOM 
L  MAJCOM 


INDICATOR_VARIABLE ; 
T_UIC; 

X_UIC; 


I_ORG_SCLASS  :  INDICATOR_VARIABLE; 
V_ORG_SCLASS  :  T_SECUR ; 


I_REC_SCLASS  :  INDICATOR_VARIABLE  range  N0T_NULL  . .  NOT_NULL 
V_REC_SCLASS  :  T_SECUR; 


V_REPORT_DATE  :  T_DATE ; 
L_REPORT_DATE  :  X_DATE ; 


I_REVAL 
V_REVAL 
L  REVAL 


INDICATOR_VARI ABLE ; 
TJREVAL; 

X_REVAL; 


I_SHORT_NAME 
V_SHORT_NAME 
L  SHORT  NAME 


INDICATCR_VARI ABLE ; 

T_SHORT_NAME; 

X_SHORT_NAME; 


I_TPSN 
V  TPSN 


INDICATOR_VARIABLE; 

T_TPSN; 


I_UIC 
V_UIC 
L  UIC 


INDICATOR_VARIABLE  range  NOT_NULL  . .  NOT_NULL 
T_UIC; 

X_UIC; 


I  ULC 


INDICATOR_VARI ABLE ; 
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V_ULC  :  T_ULC / 

L_ULC  :  X_ULC ; 

V_UPDATE_DATE  :  TJDATE; 
L_UPDATE_DATE  :  X_DATE; 

I_UTC  :  INDICATOR_VARIABLE; 

V_UTC  :  T_UTC; 

L_UTC  :  X_UTC ; 

end  DATABASE_VARIABLES ; 
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7.9  DBCGEN.ADA 


—  File:  dbcgen.ada 

—  GENERIC_DATABASE_CONVERSIONS 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J.  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  5  0-6799 


with  DATABASE_VARIABLES_ADA_SQL ; 

use  DATABASE_VARIABLES_ADA_SQL; 
package  GENERIC_DATABASE_CONVERSIONS  is 


generic 

type  INDEX_TYPE  is  range  <>; 

type  DATABASE_TYPE  is  array  (  INDEX_TYPE  )  of  CHARACTER; 
package  STRING_CONVERT  is 

procedure  INSERT_CONVERT 
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(  SOURCE  :  in  STRING; 

RESULT  :  out  DATABASE_TYPE; 

INDICATOR  :  out  INDICATOR_VARIABLE  ); 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  DAT AB ASE_TYPE ; 

INDICATOR  :  in  out  INDICATOR_VARIABLE  ) ; 

end  STRING_CONVERT; 

generic 

type  DATABASE_TYPE  is  (  <>  ); 
package  DISCRETE_CONVERT  is 

procedure  INSERT_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  out  DATAB ASE_TYPE ; 

INDICATOR  :  out  INDICATOR_VARIABLE  ) ; 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  DATABASE_TYPE ; 

INDICATOR  :  in  out  INDICATOR_VARIABLE  ) ; 

end  DISCRETE_CONVERT; 

procedure  INSERT_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  out  BOOLEAN  ) ; 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  BOOLEAN  ) ; 

type  FIELD_STATUS  is  (  BLANK  ,  POUND  ,  DATA  ) ; 

—  would  go  in  body  if  not  required  for  next  function  spec 

function  F I ELD_CONTENT S  (  S  :  STRING  )  return  FIELD_STATUS; 

—  Meridian  Ada  bug  shows  up  if  this  spec  is  not  here 

end  GENERIC_DATABASE_CONVERSIONS ; 

package  body  GENERIC_DATABASE_CONVERS IONS  is 

function  FIELD_CONTENTS  (  S  :  STRING  )  return  FIELD_STATUS  is 
begin 

for  I  in  S' RANGE  loop 
if  S(I)  =  '#'  then 
return  POUND; 
elsif  S(I)  /=  '  '  then 
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return  DATA; 
end  if; 
end  loop; 
return  BLANK; 
end  FIELD_C0NTENT3; 

package  body  STRING_CONVERT  is 

procedure  INSERT_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  out  DATABASE_TYPE; 

INDICATOR  :  out  INDICATOR_VARIABLE  )  is 

begin 

RESULT  : =  DATABASE_TYPE  {  SOURCE  ) ; 
case  F I ELD_CONTENT S  (  SOURCE  )  is 
when  BLANK  => 

INDICATOR  :=  NULL_VALUE; 
when  POUND  => 

raise  CONSTRAINT_ERROR;  —  "cannot  happen" 
when  DATA  => 

INDICATOR  : =  NOT_NULL ; 
end  case; 

end  INSERT_CONVERT ; 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  DATABASE_TYPE ; 

INDICATOR  :  in  out  INDICATOR_VARIABLE  ) 

begin 

case  FIELD_CONTENTS  (  SOURCE  )  is 
when  BLANK  => 
null  ; 

when  POUND  => 

INDICATOR  :=  NULL_VALUE; 
when  DATA  => 

INDICATOR  :=  NOT_NULL; 

RESULT  : =  DATABASE_TYPE  (  SOURCE  ) ; 
end  case; 

end  UPDATE_CONVERT ; 

end  STRING_CONVERT; 

package  body  D I S C R ET E_C ONVE RT  is 

procedure  INSERT_ CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  out  DATABASE_TYPE; 

INDICATOR  :  out  INDICATOR_VARIABLE  )  is 

begin 

case  F I ELD_CONTENTS  (  SOURCE  )  is 
when  BLANK  => 
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INDICATOR  NULL_VALUE; 

RESULT  :=  DATABASE_TYPE' FIRST; 
when  POUND  *> 

raise  CONSTRAINT_ERROR;  —  "cannot  happen" 
when  DATA  => 

INDICATOR  :=  NOT_NULL ; 

RESULT  :=*  DATABASE_TYPE '  VALUE  (  SOURCE  ); 
end  case; 

end  INSERT_CONVERT ; 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  DATABASE_TYPE ; 

INDICATOR  :  in  out  INDICATOR_VARIABLE 

begin 

case  FIELD_CONTENTS  (  SOURCE  )  is 
when  BLANK  => 
null ; 

when  POUND  => 

INDICATOR  :=  NULL_VALUE ; 
when  DATA  => 

INDICATOR  :=  NOT_NULL; 

RESULT  :=  DATABASE_TYPE' VALUE  (  SOURCE  ); 
end  case; 

end  UPDATE_CONVERT ; 

end  DISCRETE_CONVERT; 

procedure  INSERT_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  out  BOOLEAN  )  is 

begin 

case  FIELD_CONTENTS  (  SOURCE  )  is 
when  BLANK  => 

RESULT  :=  FALSE; 
when  POUND  => 

raise  CONSTRAINT_ERROR;  —  "cannot  happen" 
when  DATA  => 

RESULT  :=  TRUE; 
end  case; 

end  INSERT_CONVERT; 

procedure  UPDATE_CONVERT 

(  SOURCE  :  in  STRING; 

RESULT  :  in  out  BOOLEAN  )  is 

begin 

case  F I ELD_C ONT ENT S  (  SOURCE  )  is 
when  BLANK  => 
null ; 

when  POUND  => 

RESULT  :=  FALSE; 


is 
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when  DATA  =■> 

RESULT  TRUE; 
end  case; 

end  UPDATE_CONVERT; 
end  GENERIC  DATABASE_CONVERSIONS; 
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7.10  DBCNVRT.ADS 


—  File:  dbcnvrt.ads 

—  DATABASE_CONVERSIONS 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND 


LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT.  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by.- 
Fred  J.  Friedman 
RACOM  Computer  Professionals 
P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  DATABASEJTYPES,  GENERIC_DATABASE_CONVERSIONS ; 

use  GENERIC_DATABASE_CONVERSIONS; 
package  DATABASE_CONVERSIONS  is 

use  DATABASE_TYPES . ADA_SQL; 

package  DATE_CONVERT  is  new  STRING_CONVERT  (  X_DATE  ,  T_DATE  ) ; 
package  REVAL_CONVERT  is  new  STRING_CONVERT  (  X_REVAL  ,  T_REVAL  ) ; 
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package  SECUR_CONVERT  is  new  DISCRETE_CONVERT  (  T_SECUR  ) ; 

package  SHORT_NAME_CONVERT  is 
new  STRING_CONVERT  (  X_SHORT_NAME  ,  T_SHORT_NAME  ) ; 

package  TPSN_CONVERT  is  new  DISCRETE_CONVERT  (  T_TPSN  ) ; 

package  UIC_CONVERT  is  new  STRING_CONVERT  (  X_UIC  ,  T_UIC  ) ; 

~ package  ULC_CONVERT  is  new  STRING_CONVERT  (  X_ULC  ,  T_ULC  ) ; 

package  UTC_CONVERT  is  new  STRING_CONVERT  (  X_UTC  ,  T_UTC  ) ; 

end  DATABASE  CONVERSIONS; 
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7.11  CARD  A.  ADS 


—  File:  carda.ads 

—  DATABASE_CARD_A 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND 


LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J.  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


package  DATABASE_CARD_A  is 

subtype  CARD_TYPE  is  STRING  (  1  ..  80  )  ; 
procedure  Process_Card_A  (Card  :  in  Card_Type); 
end  DAT ABASE_CARD_A ; 
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7.12  CARDA.ADB 


—  File:  carda.adb 

—  DATABASE_CARD_A 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND  LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 


Prepared  for: 

Institute  for  Defense  Analyses 
1801  N.  Beauregard  Street 
Alexandria,  VA  22311 


Prepared  by: 

Fred  J .  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  DATABASE_CONVERSIONS ,  DATABASE_VARIABLES , 

DATABASE_CARD_A_ADA_SQL ,  GENERIC_DATABASE_CONVERSIONS ; 
use  DATABASE_CONVERSIONS,  DATABASE_VARIABLES , 
DATABASE_CARD_A_ADA_SQL,  GENERIC_DATABASE_CONVERSIONS ; 
package  body  DATABASE_CARD_A  is 

use  DATE_CONVERT ,  REVAL_CONVERT ,  SECUR_CONVERT ,  SHORT_NAME_CONVERT , 
TPSN_CONVERT,  UIC_CONVERT,  ULC_CONVERT,  UTC_CONVERT; 

procedure  Process_Card_A(Card  :  in  Card_Type)  is 
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function  Transaction_Code  (  Card  :  in  Card_Type  )  return  String  is 
begin 

return  Card  (  5  . .  5  ) ; 
end  Transaction  Code; 


begin 


INSERT_CCNVERT  (  CARD  (  9  . .  14  )  ,  V_UIC  ,  I_UIC  ) ; 
if  Transaction_Code(Card)  =  "A"  then 


INSERT- 

-CONVERT 

( 

CARD 

( 

4  . 

4 

) 

r 

V- 

_REC_SCLASS 

r 

i- 

_REC_SCLASS 

) 

INSERT, 

-CONVERT 

( 

CARD 

( 

16  . 

.  45 

) 

t 

V- 

_SHORT_NAME 

t 

i- 

_SHORT_NAME 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

46  . 

.  50 

) 

f 

V- 

-UTC 

f 

i_ 

_UTC 

) 

INSERT- 

-COI/VERT 

( 

CARD 

( 

51  . 

.  53 

) 

f 

V- 

-ULC 

t 

i- 

_ULC 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

54  . 

.  59 

) 

/ 

V- 

-MAJCOM 

/ 

i_ 

-MAJCOM 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

60  . 

.  60 

) 

/ 

V- 

-IS—MAJOR 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

61  . 

.  61 

) 

/ 

V- 

-REVAL 

/ 

i- 

REVAL 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

62  . 

.  68 

) 

t 

V- 

-TPSN 

/ 

i_ 

-TPSN 

) 

INSERT- 

-CONVERT 

( 

CARD 

( 

69  . 

.  69 

> 

t 

V- 

-ORG_SCLASS 

/ 

i_ 

ORG-SCLASS 

) 

INSERT_INTO  (  BIDE  , 
VALUES  <= 


INDICATOR  ( 
INDICATOR  ( 
INDICATOR  ( 
INDICATOR  ( 
INDICATOR  ( 
INDICATOR  ( 


V_UIC 

V_SHORT_NAME 

V_UTC 

V_ULC 

V_REVAL 

V_TPSN 

V_ORG_SCLASS 

V_REC_SCLASS 

V_REPORT_DATE 

V  UPDATE  DATE 


t 


SHORT_NAME 

UTC 

ULC 

REVAL 

TPSN 


I_ORG_SCLASS  ) 


>; 


and 

and 

and 

and 

and 

and 

and 

and 

and 


INSERT—INTO  (  COMMAND, 

VALUES  <= 

V_UIC  and 

INDICATOR  (  V_MAJCOM  ,  I_MAJCOM  )  and 
V_IS_MAJOR  and 

V_REC_SCLASS  and 

V_REPORT_DATE  and 

V_UPDATE_DATE  ) ; 


elsif  Ti ans act ion_Codc ; Card)  =  "D"  then 


DELETE 

( 

FROM 

=  > 

BIDE, 

WHERE 

=  > 

EQ  (  UIC 

,  V_UIC  )  ) ; 

DELETE 

( 

FROM 

=  > 

COMMAND, 

WHERE 

=  > 

EQ  (  UIC 

,  V_UIC  )  ); 
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elsif  Transaction_Code(Card)  »  "C"  then 


SELEC  (  SHORT_NAME  &  UTC  &  ULC  &  REVAL  S  TPSN  S  ORG_SCLASS, 
FROM  =>  BIDE, 

WHERE  =>  EQ  (  UIC  ,  V_UIC  )  ); 


INTO 

( 

V_SHORT_NAME 

,  L_SHORT_NAME 

/ 

I_SHORT_NAME 

); 

INTO 

( 

V_UTC 

,  L_UTC 

/ 

I_UTC 

)  ; 

INTO 

( 

VJJLC 

,  L_ULC 

/ 

I_ULC 

) ; 

INTO 

( 

V_REVAL 

,  L_REVAL 

/ 

I_REVAL 

)  / 

INTO 

( 

V_TPSN 

/ 

I_TPSN 

)  ; 

INTO 

( 

V_ORG_SCLASS 

/ 

I_ORG_SCLASS 

) ; 

SELEC  (  MAJCOM  &  IS_MAJOR, 
FROM  =>  COMMAND, 

WHERE  =>  EQ  (  UIC  ,  V_UIC  )  ); 
INTO  (  V_MAJCOM  ,  L_MAJCOM 
INTO  (  V_I S_MA JOR 


INSERT_ 

_CONVERT 

( 

CARD 

( 

4  . 

4 

UPDATE, 

_CONVERT 

( 

CARD 

( 

16  . 

.  45 

UPDATE, 

.CONVERT 

( 

CARD 

( 

46  . 

.  50 

UPDATE, 

.CONVERT 

( 

CARD 

( 

51  . 

.  53 

UPDATE, 

.CONVERT 

( 

CARD 

( 

54  . 

.  59 

UPDATE, 

.CONVERT 

( 

CARD 

( 

60  . 

.  60 

UPDATE, 

.CONVERT 

( 

CARD 

( 

61  . 

.  61 

UPDATE, 

.CONVERT 

( 

CARD 

( 

62  . 

.  68 

UPDATE, 

.CONVERT 

( 

CARD 

( 

69  . 

.  69 

I_MAJCOM  ); 

)/ 

)  ,  V_REC_SCLASS  ,  I_REC_SCLASS  ) ; 
)  ,  V_SHORT_NAME  ,  I_SHORT_NAME  ) ; 
)  ,  VJJTC  ,  I_UTC  )  ; 

)  ,  V_ULC  ,  I_ULC  ) ; 

)  ,  V_MAJCOM  ,  I_MAJCOM  ) ; 

)  ,  V_I S_MA J OR  ) ; 

)  ,  V_REVAL  ,  I_REVAL  ) ; 

)  ,  V_TPSN  ,  I_TPSN  ) ; 

)  ,  V_ORG_SCLASS  ,  I_ORG_SCLASS  ); 


UPDATE  ( 

BIDE, 

SET  => 

SHORT_NAME 

<= 

INDICATOR 

( 

V. 

_SHORT_NAME 

and 

UTC 

<= 

INDICATOR 

( 

V. 

.UTC 

and 

ULC 

<= 

INDICATOR 

( 

V. 

.ULC 

and 

REVAL 

<= 

INDICATOR 

( 

V. 

.REVAL 

and 

TPSN 

<= 

INDICATOR 

( 

V. 

.TPSN 

and 

ORG_SCLASS 

<  = 

INDICATOR 

( 

V. 

_ORG_SCLASS 

and 

REC_SCLASS 

<  = 

V. 

_REC_SCLASS 

and 

REPORT_DATE 

<  = 

V. 

_REPORT_DATE 

and 

UPDATE_DATE 

<= 

V. 

_UPDATE_DATE 

WHERE  => 

EQ  (  UIC  ,  V 

_UIC  )  ); 

UPDATE  ( 

COMMAND, 

SET  => 

MAJCOM 

<  = 

INDICATOR 

( 

V. 

.MAJCOM 

and 

IS_MAJOR 

<  = 

V. 

_IS_MAJOR 

and 

REC_SCLASS 

<  = 

V. 

_REC_SCLASS 

and 

REPORT_DATE 

<  = 

V. 

_REPORT_DATE 

and 

UP  DATE_DATE 

<  = 

V. 

,UPDATE_DATE 

WHERE  => 

EQ  (  UIC  ,  V 

_UIC  )  ); 

I_SHORT_NAME  ) 


I_UTC  ) 
I_ULC  ) 
I_REVAL  ) 
IJTPSN  ) 


I_ORG_SCLASS  ) 


I_MAJCOM  ) 


else 


null ; 
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end  if; 

end  Process_Card_A; 
end  DATABASE  CARD_A; 
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7.13  MAIN. ADA 


—  File:  main.ada 

—  MAIN 

—  12/18/88 


DISCLAIMER  OF  WARRANTY  AND 


LIABILITY 


THIS  IS  EXPERIMENTAL  PROTOTYPE  SOFTWARE.  IT  IS  PROVIDED  "AS  IS" 
WITHOUT  WARRANTY  OR  REPRESENTATION  OF  ANY  KIND.  THE  INSTITUTE 
FOR  DEFENSE  ANALYSES  (IDA)  DOES  NOT  WARRANT,  GUARANTEE,  OR  MAKE 
ANY  REPRESENTATIONS  REGARDING  THIS  SOFTWARE  WITH  RESPECT  TO 
CORRECTNESS,  ACCURACY,  RELIABILITY,  MERCHANTABILITY,  FITNESS  FOR 
A  PARTICULAR  PURPOSE,  OR  OTHERWISE. 

USERS  ASSUME  ALL  RISKS  IN  USING  THIS  SOFTWARE.  NEITHER  IDA  NOR 
ANYONE  ELSE  INVOLVED  IN  THE  CREATION,  PRODUCTION,  OR  DISTRIBUTION 
OF  THIS  SOFTWARE  SHALL  BE  LIABLE  FOR  ANY  DAMAGE,  INJURY,  OR  LOSS 
RESULTING  FROM  ITS  USE,  WHETHER  SUCH  DAMAGE,  INJURY,  OR  LOSS  IS 
CHARACTERIZED  AS  DIRECT,  INDIRECT,  CONSEQUENTIAL,  INCIDENTAL, 
SPECIAL,  OR  OTHERWISE. 

—  Prepared  for : 

—  Institute  for  Defense  Analyses 

—  1801  N.  Beauregard  Street 

—  Alexandria,  VA  22311 


Prepared  by: 

Fred  J.  Friedman 

RACOM  Computer  Professionals 

P.O.  Box  576 

Annandale,  VA  22003-1620 

(703)  560-6813  (703)  560-6799 


with  DATABASE_CARD_A ,  DAT AB ASE_CARD_A_ADA_SQL ,  DATABASE_VARIABLES ,  TEXT_PRINT; 

use  DATABASE_CARD_A ,  DATABASE_CARD_A_ADA_SQL ,  DATABASE_VARIABLES ,  TEXT_PRINT; 
procedure  MAIN  is 

subtype  SHORT_CARD_INDEX  is  POSITIVE  range  1  . .  69; 

subtype  SHORT_CARD  is  STRING  (  SHORT_CARD_INDEX  ) ; 

type  TEST_CARDS  is  array  (  POSITIVE  range  <>  )  of  SHORT_CARD ; 
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CARDS  :  constant  TEST  CARDS  := 


ft 

UA 

UIC001 

Test  Card  1  (add) 

UTC01LC1MJCOM1  IGOOOGOlU", 

tt 

UC 

UIC002 

Change  non-existent  card 

U", 

n 

CC 

UIC001 

Change  with  explicit  fields 

UTC02LC2MJCOM2X20000002C" , 

tt 

SC 

UIC001 

Change  with  blank  fields 

s\ 

tt 

TC 

UIC001 

Change  with  #  fields 

#  #  #  ###  T", 

tt 

UC 

UIC001 

Change  to  show  results 

UTC03LC3MJCOM3X30000003U" , 

tt 

CA 

UIC004 

Test  Card  4  (add  null  fields) 

MJCOM4  C", 

tt 

SC 

UIC004 

Change  with  blank  fields 

S", 

tt 

TC 

UIC004 

Change  with  #  fields 

#  #  #  ###  T", 

tt 

SC 

UIC004 

Change  to  show  results 

UTC05LC5MJCOM5X50000005S" , 

tt 

UD 

UIC004 

Delete  Card  4 

U", 

tt 

UD 

UIC004 

Delete  Card  4  again  (error) 

U”, 

tt 

UC 

UIC004 

Change  Card  4  (also  error) 

U", 

tt 

TC 

UIC001 

Change  Card  1  (ok) 

UTCO6LC6MJCOM6X6OOOOOO6T"  , 

tt 

UD 

UIC001 

Delete  Card  1  -  end  of  demo 

U"  ) 

CARD  :  CARDJTYPE  :=  (  Others  =>  '  '  ); 

begin 

V_REPORT_DATE  :=  "ReportDa"; 

V_UPDATE_DATE  :=  "UpdateDa"; 

INITIATE_TEST; 

for  I  in  CARDS' RANGE  loop 
BLANK_LINE;  BLANK_LINE; 

PRINT  (  "Card:  "  );  PRINT  (  CARDS  {  I  )  );  PRINTJLINE; 

CARD  (  SHORT_CARD_INDEX ' FIRST  ..  SHORT_CARD_INDEX' LAST  )  :=  CARDS  (  I  )  ; 

begin 

PROCESS_CARD_A  (  CARD  ) ; 
exception 

when  NO_DATA  =>  null; 
end; 

end  loop; 
end  MAIN; 


7.14  Demonstration  Output 


Card:  UA  UIC001  Test  Card  1  (add) 

INSERT  INTO  BIDE 

VALUES  (  'UIC001',  'Test  Card  1  (add) 

,  ' LC1 '  NOT_NULL,  ' 1'  NOT_NULL , 

,  'UpdateDa'  ) 


UTC01LC1MJCOM1  10000001U 

'  MOT_NULL,  ' UTC01 '  NOT_NULL 
1  NOT_NULL,  0  NOT_NULL,  0,  'ReportDa' 


INSERT  INTO  COMMAND 
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VALUES  (  'UICOOl',  'MJCOM1 '  NOT_NULL,  0,  0,  'ReportDa',  'UpdateDa'  ) 


Card:  UC  UIC002  Change  non-existent  card  U 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  ' UIC002 ' 

*****  no  DATA  ***** 


Card:  CC  UICOOl  Change  with  explicit  fields  UTC02LC2MJCOM2X20000002C 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  'UICOOl' 

INTO  returning  'Test  Card  1  (add)  '  NOT_NULL 

INTO  returning  'UTC01'  NOT_NULL 

INTO  returning  'LC1'  NOT_NULL 

INTO  returning  '1'  NOT_NULL 

INTO  returning  1  NOT_NULL 

INTO  returning  0  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  'UICOOl' 

INTO  returning  'MJCOM1'  NOT_NULL 
INTO  returning  0 

UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  with  explicit  fields  '  NOT_NULL, 

UTC  =  ' UTC02 '  NOT_NULL, 

ULC  =  ' LC2 '  NOT_NULL, 

REVAL  =  '2'  NOT_NULL, 

TPSN  =  2  NOT_NULL , 

ORG_SCLASS  =  1  NOT_NULL , 

REC_SCLASS  =  1, 

REPORT_DATE  =  'ReportDa', 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  'UICOOl' 

UPDATE  COMMAND 

SET  MAJCOM  =  'MJCOM2'  NOT_NULL , 

IS_MAJOR  =  1, 

REC_SCLASS  =  1, 

REPORT_D AT  E  =  'ReportDa', 

UPDATE_DATE  -  'UpdateDa' 

WHERE  UIC  =  'UICOOl' 


Card:  SC  UICOOl  Change  with  blank  fields  S 
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SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  -  'UIC001' 

INTO  returning  'Change  with  explicit  fields  '  NOT_NULL 

INTO  returning  ' UTC02 '  NOT_NULL 

INTO  returning  ' LC2'  NOT_NULL 

INTO  returning  '2'  NOT_NULL 

INTO  returning  2  NOT_NULL 

INTO  returning  1  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  'UIC001' 

INTO  returning  ' MJCOM2 '  NOT_NULL 
INTO  returning  1 


UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  with  blank  fields  '  NOT_NULL, 

UTC  =  '  UTC  0  2 '  NOT_NULL, 

ULC  =  ' LC2 '  NOT_NULL, 

REVAL  =  '2'  NOT_NULL, 

TPSN  =  2  NOT_NULL , 

ORG_SCLASS  =  2  NOT_NULL, 

?.LC_SCL?CC  -  2, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  'UIC001' 

UPDATE  COMMAND 

SET  MAJCOM  »  ' MJCOM2 '  NOT_NULL, 

IS_MAJOR  =  1, 

REC_SCLASS  =  2, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATEJDATE  =  'UpdateDa' 

WHERE  UIC  =  'UIC001' 


Card:  TC  UIC001  Change  with  #  fields  #  #  #  ###  T 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  'UIC001' 

INTO  returning  'Change  with  blank  fields  '  NOT_NULL 

INTO  returning  ' UTC02 '  NOT_NULL 

INTO  returning  ' LC2 '  NOT_NULL 

INTO  returning  '2'  NOT_NULL 

INTO  returning  2  NOT_NULL 

INTO  returning  2  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 
FROM  COMMAND 
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WHERE  UIC  -  'UIC001' 

INTO  returning  'MJCOM2 '  NOT_NULL 
INTO  returning  1 

UPDATE  BIDE 

SET  SHORT_NAME  -  'Change  with  #  fields  '  NOT_NULL, 

UTC  -  ' UTC02 '  NULL_VALUE, 

ULC  -  ' LC2 '  NULL_VALUE, 

REVAL  -  '2'  NULL_VALUE , 

TPSN  -  2  NULL_VALUE, 

ORG_SCLASS  =  3  NOT_NULL , 

REC_SCLASS  »  3, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  'UIC001' 

UPDATE  COMMAND 

SET  MAJCOM  *»  'MJCOM2'  NULL__VALUE , 

IS_MAJOR  =  0, 

REC_SCLASS  =  3, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  'UIC001' 


Card.  UC  UIC001  Change  to  show  results  UTC03LC3MJCOM3X30000003U 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  ' UTC001 ' 

INTO  returning  'Change  with  #  fields  '  NOT_NULL 

INTO  returning  ' UTC02 '  NULL_VALUE 

INTO  returning  ' LC2 '  NULL_VALUE 

INTO  returning  '2'  NULL_VALUE 

INTO  returning  2  NULL_VALUE 

INTO  returning  3  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  'UIC001' 

INTO  returning  'MJCOM2 '  NULL_VALUE 
INTO  returning  0 


UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  tc  show  results  '  NOT_NULL, 

UTC  =  ' UTC03 '  NOT_NULL, 

ULC  *  ' LC3 '  NOT_NULL, 

REVAL  -  '3'  NOT_NULL, 

TPSN  =  3  NOT_NULL , 

ORG_SCLASS  -  0  NOT_NULL , 

REC_SCLASS  -  0, 
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REPORT_DATE  -  'ReportDa', 
UPDATE_DATE  -  'UpdateDa' 
WHERE  UIC  -  'UIC001' 

UPDATE  COMMAND 

SET  MAJCOM  -  'MJCOM3'  NOT_NULL , 
IS_MAJOR  -  1, 

REC_SCLASS  -  0, 

REPORT_DATE  -  'ReportDa', 
UPDATE_DATE  -  'UpdateDa' 
WHERE  UIC  -  'UIC001' 


Card:  CA  UIC004  Test  Card  4  (add  null  fields)  MJCOM4 

INSERT  INTO  BIDE 

VALUES  (  ' UIC004 ' ,  'Test  Card  4  (add  null  fields)  '  NOT_NULL,  '  ' 

NULL_VALUE ,  '  '  NULLJVALUE,  '  '  NULL_VALUE ,  0  NULL_VALUE,  1 

NOT_NULL ,  1,  'ReportDa',  'UpdateDa'  ) 

INSERT  INTO  COMMAND 

VALUES  (  ' UIC004 ' ,  ' MJCOM4 '  NOT_NULL,  0,  1,  'ReportDa',  'UpdateDa'  ) 


Card:  SC  UIC004  Change  with  blank  fields 

SELECT  SHORT_NAME ,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  -  ' UIC004 ' 

INTO  returning  'Test  Card  4  (add  null  fields)  '  NOT_NULL 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  0  NULL_VALUE 

INTO  returning  1  NOT_NULL 


SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  ' UIC004 ' 

INTO  returning  'MJCOM4 '  NOT_NULL 
INTO  returning  0 


UPDATE  BIDE 

SET  SHO°T_NAME  =  'Change  with  blank  fields  '  NOT_NULL, 

UTC  =  '  '  NULL_VALUE, 

ULC  =  '  '  NULL_VALUE , 

REVAL  =  '  '  NULL_VALUE, 

TPSN  ■  0  NULL_VALUE , 

ORG_SCLASS  =  2  NOT_NULL , 

REC_SCLASS  =  2, 

REPORT_DATE  -  ' ReportDa ' , 
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UPDATE_DATE  =*  'UpdateDa' 
WHERE  UIC  =  ' UIC004 ' 

UPDATE  COMMAND 

SET  MAJCOM  -  ' MJCOM4 '  NOT_NULL, 
IS_MAJOR  -  0, 

REC_SCLASS  =  2, 

REPORT_DATE  =  ' ReportDa ' , 
UPDATE_DATE  -  'UpdateDa' 
WHERE  UIC  =  ' UIC004 ' 


Card:  TC  UIC004  Change  with  #  fields  #  # 

SELECT  SHORT_NAME,  UT C,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  ' UIC004 ' 

INTO  returning  'Change  with  blank  fields  '  NOT_NULL 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  0  NULL_VALUE 

INTO  returning  2  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  ' UIC004 ' 

INTO  returning  'MJCOM4'  NOT_NULL 
INTO  returning  0 

UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  with  §  fields  '  NOT_NULL, 

UTC  =  '  '  NULL_VALUE , 

ULC  =  '  '  NULL_VALUE , 

REVAL  =  '  '  NULL_VALUE, 

TPSN  =  0  NULL_VALUE, 

ORG_SCLASS  =  3  NOT_NULL , 

REC_SCLASS  =  3, 

REPORT_DATE  =  'ReportDa', 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =>  '  UIC004  ' 

UPDATE  COMMAND 

SET  MAJCOM  =  ' MJCOM4 '  NULL_VALUE, 

IS_MAJOR  -  0, 

REC_SCLASS  =  3, 

REPORT_DATE  =  'ReportDa', 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  ' UIC004 ' 
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Card:  SC  UIC004  Change  to  show  results  UTC05LC5MJCOM5X50000005S 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  ' UIC0C4 ' 

INTO  returning  'Change  with  #  fields  '  NOT_NULL 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  '  '  NULL_VALUE 

INTO  returning  0  NULL_VALUE 

INTO  returning  3  NOT_NULL 


SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  ' UIC004 ' 

INTO  returning  'MJCOM4'  NULL_VALUE 
INTO  returning  0 

UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  to  show  results  '  NOT_NULL, 

UTC  =  ' UTC 05 '  NOT_NULL, 

ULC  =  ' LC5 '  NOT_NULL, 

REVAL  =  '5'  NOT_NULL , 

TPSN  =  5  NOT_NULL , 

ORG_SCLASS  =  2  NOT_NULL, 

REC_SCLASS  =  2, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  ' UIC004 ' 

UPDATE  COMMAND 

SET  MAJCOM  =  'MJCOM5 '  NOT_NULL , 

IS_MAJOR  =  1, 

REC_SCLASS  =  2, 

REPORT_DATE  =  ' ReportDa ' , 

UPDATE_DATE  =  ' UpdateDa ' 

WHERE  UIC  =  ' UIC004 ' 


Card: 

UD 

UIC004 

Delete 

Card  4 

U 

DELETE 

BIDE 

WHERE 

UIC  = 

' UIC004 ' 

DELETE 

COMMAND 

WHERE 

UIC  = 

' UIC004 ' 

Card : 

UD 

UIC004 

Delete 

Card  4  again  (error) 

U 

DELETE  BIDE 
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WHERE  UIC  =  ' UIC004 ' 
*****  NO  DATA  ***** 

DELETE  COMMAND 
WHERE  UIC  =  ' UIC004 ' 
*****  NO  DATA  ***** 


Card:  UC  UIC004  Change  Card  4  (also  error)  U 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  ' UIC004 ' 

*****  NO  DATA  ***** 


Card:  TC  UIC001  Change  Card  1  (ok)  UTCO6LC6MJCOM6X6OOOOOO6T 

SELECT  SHORT_NAME,  UTC,  ULC,  REVAL,  TPSN,  ORG_SCLASS 

FROM  BIDE 

WHERE  UIC  =  'UIC001' 

INTO  returning  'Change  to  show  results  '  NOT_NULL 

INTO  returning  ' UTC 03 '  NOT_NULL 

INTO  returning  ' LC3 '  NOT_NULL 

INTO  returning  '3'  NOT_NULL 

INTO  returning  3  NOT_NULL 

INTO  returning  0  NOT_NULL 

SELECT  MAJCOM,  IS_MAJOR 

FROM  COMMAND 

WHERE  UIC  =  'UIC001' 

INTO  returning  'MJCOM3 '  NOT_NULL 
INTO  returning  1 


UPDATE  BIDE 

SET  SHORT_NAME  =  'Change  Card  1  (ok)  '  NOT_NULL , 

UTC  =  ' UTC06 '  NOT_NULL, 

ULC  =  ' LC6 '  NOT_NULL, 

REVAL  =  '6'  NOT_NULL, 

TPSN  =  6  NOT_NULL , 

ORG_SCLASS  =  3  NOT_NULL, 

REC_SCLASS  =  3, 

REPORT_DATE  =  'ReportDa', 

UPDATE_DATE  =  'UpdateDa' 

WHERE  UIC  =  'UIC001' 

UPDATE  COMMAND 

SET  MAJCOM  =  ' MJCOM6 '  NOT_NULL, 

IS_MAJOR  =  1, 

REC_SCLASS  =  3, 

REPORT_DATE  =  'ReportDa', 
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UPDATE_DATE  -  'UpdateDa' 
WHERE  UIC  *  'UIC001' 


Card:  UD  UIC001  Delete  Card  1  -  end  of  demo 

DELETE  BIDE 

WHERE  UIC  =  'UIC001' 

DELETE  COMMAND 
WHERE  UIC  =  'UIC001' 
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